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

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

lisp: start refactoring the core engine and garbage collector.

File size: 7.7 KB
Line 
1/*
2 *  Abuse - dark 2D side-scrolling platform game
3 *  Copyright (c) 1995 Crack dot Com
4 *
5 *  This software was released into the Public Domain. As with most public
6 *  domain software, no warranty is made or implied by Crack dot Com or
7 *  Jonathan Clark.
8 */
9
10#include "config.h"
11
12#include <stdlib.h>
13#include <string.h>
14
15#include "lisp.hpp"
16#ifdef NO_LIBS
17#include "fakelib.hpp"
18#else
19#include "macs.hpp"
20#endif
21
22#include "stack.hpp"
23
24/*  Lisp garbage collection: uses copy/free algorithm
25    Places to check:
26      symbol
27        values
28    functions
29    names
30      stack
31*/
32
33// Stack where user programs can push data and have it GCed
34grow_stack<void> l_user_stack(150);
35// Stack of user pointers
36grow_stack<void *> l_ptr_stack(1500);
37
38size_t reg_ptr_total = 0;
39size_t reg_ptr_list_size = 0;
40void ***reg_ptr_list = NULL;
41
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
59void register_pointer(void **addr)
60{
61  if (reg_ptr_total >= reg_ptr_list_size)
62  {
63    reg_ptr_list_size += 0x100;
64    reg_ptr_list = (void ***)realloc(reg_ptr_list, sizeof(void **) * reg_ptr_list_size);
65  }
66  reg_ptr_list[reg_ptr_total++] = addr;
67}
68
69void unregister_pointer(void **addr)
70{
71  void ***reg_on = reg_ptr_list;
72  for (size_t i = 0; i < reg_ptr_total; i++, reg_on++)
73  {
74    if (*reg_on == addr)
75    {
76      reg_ptr_total--;
77      for (size_t j = i; j < reg_ptr_total; j++, reg_on++)
78        reg_on[0] = reg_on[1];
79      return ;
80    }
81  }
82  fprintf(stderr, "Unable to locate ptr to unregister");
83}
84
85static void *collect_object(void *x);
86static void *collect_array(void *x)
87{
88  long s = ((lisp_1d_array *)x)->size;
89  lisp_1d_array *a = new_lisp_1d_array(s, NULL);
90  void **src, **dst;
91  src = (void **)(((lisp_1d_array *)x)+1);
92  dst = (void **)(a+1);
93  for (int i = 0; i<s; i++)
94    dst[i] = collect_object(src[i]);
95
96  return a;
97}
98
99inline void *collect_cons_cell(void *x)
100{
101  cons_cell *last = NULL, *first = NULL;
102  if (!x) return x;
103  for (; x && item_type(x) == L_CONS_CELL; )
104  {
105    cons_cell *p = new_cons_cell();
106    void *old_car = ((cons_cell *)x)->car;
107    void *old_cdr = ((cons_cell *)x)->cdr;
108    void *old_x = x;
109    x = CDR(x);
110    ((lisp_collected_object *)old_x)->type = L_COLLECTED_OBJECT;
111    ((lisp_collected_object *)old_x)->new_reference = p;
112
113    p->car = collect_object(old_car);
114    p->cdr = collect_object(old_cdr);
115   
116    if (last) last->cdr = p;
117    else first = p;
118    last = p;
119  }
120  if (x)
121    last->cdr = collect_object(x);
122  return first;                    // we already set the collection pointers
123}
124
125static void *collect_object(void *x)
126{
127  void *ret = x;
128
129  if (((uint8_t *)x) >= cstart && ((uint8_t *)x) < cend)
130  {
131    //dump_memory(x, 32, 48);
132    switch (item_type(x))
133    {
134      case L_BAD_CELL:
135        lbreak("error: GC corrupted cell\n");
136        break;
137      case L_NUMBER:
138        ret = new_lisp_number(((lisp_number *)x)->num);
139        break;
140      case L_SYS_FUNCTION:
141        ret = new_lisp_sys_function(((lisp_sys_function *)x)->min_args,
142                                    ((lisp_sys_function *)x)->max_args,
143                                    ((lisp_sys_function *)x)->fun_number);
144        break;
145      case L_USER_FUNCTION:
146#ifndef NO_LIBS
147        ret = new_lisp_user_function(((lisp_user_function *)x)->alist,
148                                     ((lisp_user_function *)x)->blist);
149
150#else
151        {
152          void *arg = collect_object(((lisp_user_function *)x)->arg_list);
153          void *block = collect_object(((lisp_user_function *)x)->block_list);
154          ret = new_lisp_user_function(arg, block);
155        }
156#endif
157        break;
158      case L_STRING:
159        ret = new_lisp_string(lstring_value(x));
160        break;
161      case L_CHARACTER:
162        ret = new_lisp_character(lcharacter_value(x));
163        break;
164      case L_C_FUNCTION:
165        ret = new_lisp_c_function(((lisp_sys_function *)x)->min_args,
166                                  ((lisp_sys_function *)x)->max_args,
167                                  ((lisp_sys_function *)x)->fun_number);
168        break;
169      case L_C_BOOL:
170        ret = new_lisp_c_bool(((lisp_sys_function *)x)->min_args,
171                              ((lisp_sys_function *)x)->max_args,
172                              ((lisp_sys_function *)x)->fun_number);
173        break;
174      case L_L_FUNCTION:
175        ret = new_user_lisp_function(((lisp_sys_function *)x)->min_args,
176                                     ((lisp_sys_function *)x)->max_args,
177                                     ((lisp_sys_function *)x)->fun_number);
178        break;
179      case L_POINTER:
180        ret = new_lisp_pointer(lpointer_value(x));
181        break;
182      case L_1D_ARRAY:
183        ret = collect_array(x);
184        break;
185      case L_FIXED_POINT:
186        ret = new_lisp_fixed_point(lfixed_point_value(x));
187        break;
188      case L_CONS_CELL:
189        ret = collect_cons_cell((cons_cell *)x);
190        break;
191      case L_OBJECT_VAR:
192        ret = new_lisp_object_var(((lisp_object_var *)x)->number);
193        break;
194      case L_COLLECTED_OBJECT:
195        ret = ((lisp_collected_object *)x)->new_reference;
196        break;
197      default:
198        dump_memory(x, 8, 196);
199        //*(char *)NULL = 0;
200        lbreak("shouldn't happen. collecting bad object 0x%x\n",
201               item_type(x));
202        break;
203    }
204    ((lisp_collected_object *)x)->type = L_COLLECTED_OBJECT;
205    ((lisp_collected_object *)x)->new_reference = ret;
206  }
207  else if ((uint8_t *)x < collected_start || (uint8_t *)x >= collected_end)
208  {
209    if (item_type(x) == L_CONS_CELL) // still need to remap cons_cells outside of space
210    {
211      for (; x && item_type(x) == L_CONS_CELL; x = CDR(x))
212        ((cons_cell *)x)->car = collect_object(((cons_cell *)x)->car);
213      if (x)
214        ((cons_cell *)x)->cdr = collect_object(((cons_cell *)x)->cdr);
215    }
216  }
217
218  return ret;
219}
220
221static void collect_symbols(lisp_symbol *root)
222{
223  if (root)
224  {
225    root->value = collect_object(root->value);
226    root->function = collect_object(root->function);
227    root->name = collect_object(root->name);
228    collect_symbols(root->left);
229    collect_symbols(root->right);
230  }
231}
232
233static void collect_stacks()
234{
235  long t = l_user_stack.son;
236
237  void **d = l_user_stack.sdata;
238  for (int i = 0; i < t; i++, d++)
239    *d = collect_object(*d);
240
241  t = l_ptr_stack.son;
242  void ***d2 = l_ptr_stack.sdata;
243  for (int i = 0; i < t; i++, d2++)
244  {
245    void **ptr = *d2;
246    *ptr = collect_object(*ptr);
247  }
248
249  d2 = reg_ptr_list;
250  for (size_t i = 0; i < reg_ptr_total; i++, d2++)
251  {
252    void **ptr = *d2;
253    *ptr = collect_object(*ptr);
254  }
255}
256
257void collect_space(int which_space) // should be tmp or permanent
258{
259  return; /* XXX */
260
261  int old_space = current_space;
262  cstart = space[which_space];
263  cend = free_space[which_space];
264
265  space_size[GC_SPACE] = space_size[which_space];
266  uint8_t *new_space = (uint8_t *)malloc(space_size[GC_SPACE]);
267  current_space = GC_SPACE;
268  free_space[GC_SPACE] = space[GC_SPACE] = new_space;
269
270  collected_start = new_space;
271  collected_end = new_space + space_size[GC_SPACE];
272
273//dump_memory((char *)lsym_root->name, 128, 196);
274//dump_memory((char *)0xb6782025, 32, 48);
275  collect_symbols(lsym_root);
276  collect_stacks();
277
278  // for debuging clear it out
279  memset(space[which_space], 0, space_size[which_space]);
280  free(space[which_space]);
281
282  space[which_space] = new_space;
283  free_space[which_space] = new_space
284                          + (free_space[GC_SPACE] - space[GC_SPACE]);
285  current_space = old_space;
286}
287
Note: See TracBrowser for help on using the repository browser.