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

Last change on this file since 481 was 481, checked in by Sam Hocevar, 10 years ago

Fuck the history, I'm renaming all .hpp files to .h for my own sanity.

File size: 7.6 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.h"
16#ifdef NO_LIBS
17#include "fakelib.h"
18#else
19#include "macs.h"
20#endif
21
22#include "stack.h"
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.