Ignore:
Timestamp:
Apr 17, 2011, 10:27:59 AM (11 years ago)
Author:
Sam Hocevar
Message:

lisp: start refactoring the core engine and garbage collector.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • abuse/trunk/src/lisp/lisp_gc.cpp

    r129 r480  
    2222#include "stack.hpp"
    2323
    24 /*  Lisp garbage collections : uses copy/free algorithm
    25     Places to check :
     24/*  Lisp garbage collection: uses copy/free algorithm
     25    Places to check:
    2626      symbol
    2727        values
     
    3636grow_stack<void *> l_ptr_stack(1500);
    3737
    38 int reg_ptr_total = 0;
    39 int reg_ptr_list_size = 0;
     38size_t reg_ptr_total = 0;
     39size_t reg_ptr_list_size = 0;
    4040void ***reg_ptr_list = NULL;
    4141
     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
    4259void register_pointer(void **addr)
    4360{
    44   if (reg_ptr_total>=reg_ptr_list_size)
    45   {
    46     reg_ptr_list_size+=0x100;
    47     reg_ptr_list=(void ***)realloc(reg_ptr_list,sizeof(void **)*reg_ptr_list_size);
    48   }
    49   reg_ptr_list[reg_ptr_total++]=addr;
    50 }
    51 
     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}
    5268
    5369void unregister_pointer(void **addr)
    5470{
    55   int i;
    56   void ***reg_on=reg_ptr_list;
    57   for (i=0;i<reg_ptr_total;i++,reg_on++)
    58   {
    59     if (*reg_on==addr)
     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)
    6075    {
    61       int j;
    6276      reg_ptr_total--;
    63       for (j=i;j<reg_ptr_total;j++,reg_on++)
    64         reg_on[0]=reg_on[1];
     77      for (size_t j = i; j < reg_ptr_total; j++, reg_on++)
     78        reg_on[0] = reg_on[1];
    6579      return ;
    6680    }
    6781  }
    68   fprintf(stderr,"Unable to locate ptr to unregister");
     82  fprintf(stderr, "Unable to locate ptr to unregister");
    6983}
    7084
     
    7286static void *collect_array(void *x)
    7387{
    74   long s=((lisp_1d_array *)x)->size;
    75   lisp_1d_array *a=new_lisp_1d_array(s,NULL);
    76   void **src,**dst;
    77   src=(void **)(((lisp_1d_array *)x)+1);
    78   dst=(void **)(a+1);
    79   for (int i=0;i<s;i++)
    80     dst[i]=collect_object(src[i]);
     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]);
    8195
    8296  return a;
    8397}
    8498
    85 static uint8_t *cstart,*cend,*collected_start,*collected_end;
    86 
    8799inline void *collect_cons_cell(void *x)
    88100{
    89   cons_cell *last=NULL,*first=NULL;
     101  cons_cell *last = NULL, *first = NULL;
    90102  if (!x) return x;
    91   for (;x && item_type(x)==L_CONS_CELL;)
    92   {
    93     cons_cell *p=new_cons_cell();
    94     void *old_car=((cons_cell *)x)->car;
    95     void *old_cdr=((cons_cell *)x)->cdr;
    96     void *old_x=x;
    97     x=CDR(x);
    98     ((lisp_collected_object *)old_x)->type=L_COLLECTED_OBJECT;
    99     ((lisp_collected_object *)old_x)->new_reference=p;
    100 
    101     p->car=collect_object(old_car);
    102     p->cdr=collect_object(old_cdr);
     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);
    103115   
    104     if (last) last->cdr=p;
    105     else first=p;
    106     last=p;
     116    if (last) last->cdr = p;
     117    else first = p;
     118    last = p;
    107119  }
    108120  if (x)
    109     last->cdr=collect_object(x);
     121    last->cdr = collect_object(x);
    110122  return first;                    // we already set the collection pointers
    111123}
     
    113125static void *collect_object(void *x)
    114126{
    115   void *ret=x;
    116 
    117   if (((uint8_t *)x)>=cstart && ((uint8_t *)x)<cend)
    118   {
     127  void *ret = x;
     128
     129  if (((uint8_t *)x) >= cstart && ((uint8_t *)x) < cend)
     130  {
     131    //dump_memory(x, 32, 48);
    119132    switch (item_type(x))
    120133    {
    121       case L_BAD_CELL :
    122       { lbreak("error : GC corrupted cell\n"); } break;
    123 
    124       case L_NUMBER :
    125       { ret=new_lisp_number(((lisp_number *)x)->num); } break;
    126 
    127 
    128       case L_SYS_FUNCTION :
    129       { ret=new_lisp_sys_function( ((lisp_sys_function *)x)->min_args,
    130                       ((lisp_sys_function *)x)->max_args,
    131                       ((lisp_sys_function *)x)->fun_number);
    132       } break;
    133       case L_USER_FUNCTION :
    134       {
     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:
    135146#ifndef NO_LIBS
    136     ret=new_lisp_user_function( ((lisp_user_function *)x)->alist,
    137                        ((lisp_user_function *)x)->blist);
     147        ret = new_lisp_user_function(((lisp_user_function *)x)->alist,
     148                                     ((lisp_user_function *)x)->blist);
    138149
    139150#else
    140     void *arg=collect_object(((lisp_user_function *)x)->arg_list);
    141     void *block=collect_object(((lisp_user_function *)x)->block_list);
    142     ret=new_lisp_user_function(arg,block);
     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        }
    143156#endif
    144       } break;
    145       case L_STRING :
    146       { ret=new_lisp_string(lstring_value(x)); } break;
    147 
    148       case L_CHARACTER :
    149       { ret=new_lisp_character(lcharacter_value(x)); } break;
    150 
    151       case L_C_FUNCTION :
    152       {
    153     ret=new_lisp_c_function( ((lisp_sys_function *)x)->min_args,
    154                       ((lisp_sys_function *)x)->max_args,
    155                       ((lisp_sys_function *)x)->fun_number);
    156       } break;
    157 
    158       case L_C_BOOL :
    159       {
    160     ret=new_lisp_c_bool( ((lisp_sys_function *)x)->min_args,
    161                       ((lisp_sys_function *)x)->max_args,
    162                       ((lisp_sys_function *)x)->fun_number);
    163       } break;
    164       case L_L_FUNCTION :
    165       {
    166     ret=new_user_lisp_function( ((lisp_sys_function *)x)->min_args,
    167                       ((lisp_sys_function *)x)->max_args,
    168                       ((lisp_sys_function *)x)->fun_number);
    169       } break;
    170 
    171       case L_POINTER :
    172       { ret=new_lisp_pointer(lpointer_value(x)); } break;
    173 
    174 
    175       case L_1D_ARRAY :
    176       { ret=collect_array(x); } break;
    177 
    178       case L_FIXED_POINT :
    179       { ret=new_lisp_fixed_point(lfixed_point_value(x)); } break;
    180 
    181       case L_CONS_CELL :
    182       { ret=collect_cons_cell((cons_cell *)x); } break;
    183 
    184       case L_OBJECT_VAR :
    185       {
    186     ret=new_lisp_object_var( ((lisp_object_var *)x)->number);
    187       } break;
    188       case L_COLLECTED_OBJECT :
    189       {
    190     ret=((lisp_collected_object *)x)->new_reference;
    191       } break;
    192 
    193       default :
    194       { lbreak("shouldn't happen. collecting bad object\n"); } break;
     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;
    195203    }
    196     ((lisp_collected_object *)x)->type=L_COLLECTED_OBJECT;
    197     ((lisp_collected_object *)x)->new_reference=ret;
    198   } else if ((uint8_t *)x<collected_start || (uint8_t *)x>=collected_end)
    199   {
    200     if (item_type(x)==L_CONS_CELL) // still need to remap cons_cells outside of space
     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
    201210    {
    202       for (;x && item_type(x)==L_CONS_CELL;x=CDR(x))
    203         ((cons_cell *)x)->car=collect_object(((cons_cell *)x)->car);
     211      for (; x && item_type(x) == L_CONS_CELL; x = CDR(x))
     212        ((cons_cell *)x)->car = collect_object(((cons_cell *)x)->car);
    204213      if (x)
    205         ((cons_cell *)x)->cdr=collect_object(((cons_cell *)x)->cdr);
     214        ((cons_cell *)x)->cdr = collect_object(((cons_cell *)x)->cdr);
    206215    }
    207216  }
     
    214223  if (root)
    215224  {
    216     root->value=collect_object(root->value);
    217     root->function=collect_object(root->function);
    218     root->name=collect_object(root->name);
     225    root->value = collect_object(root->value);
     226    root->function = collect_object(root->function);
     227    root->name = collect_object(root->name);
    219228    collect_symbols(root->left);
    220229    collect_symbols(root->right);
     
    224233static void collect_stacks()
    225234{
    226   long t=l_user_stack.son;
    227   void **d=l_user_stack.sdata;
    228   int i=0;
    229   for (;i<t;i++,d++)
    230     *d=collect_object(*d);
    231 
    232   t=l_ptr_stack.son;
    233   void ***d2=l_ptr_stack.sdata;
    234   for (i=0;i<t;i++,d2++)
    235   {
    236     void **ptr=*d2;
    237     *ptr=collect_object(*ptr);
    238   }
    239 
    240   d2=reg_ptr_list;
    241   for (t=0;t<reg_ptr_total;t++,d2++)
    242   {
    243     void **ptr=*d2;
    244     *ptr=collect_object(*ptr);
    245   }
    246 
    247 }
    248 
    249 void collect_space(int which_space) // should be tmp or permenant
     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
    250258{
    251259  return; /* XXX */
    252260
    253   int old_space=current_space;
    254   cstart=(uint8_t *)space[which_space];
    255   cend=(uint8_t *)free_space[which_space];
    256 
    257   space_size[GC_SPACE]=space_size[which_space];
    258   void *new_space=malloc(space_size[GC_SPACE]);
    259   current_space=GC_SPACE;
    260   free_space[GC_SPACE]=space[GC_SPACE]=(char *)new_space;
    261 
    262   collected_start=(uint8_t *)new_space;
    263   collected_end=(((uint8_t *)new_space)+space_size[GC_SPACE]);
    264 
     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);
    265275  collect_symbols(lsym_root);
    266276  collect_stacks();
    267277
    268   memset(space[which_space],0,space_size[which_space]);  // for debuging clear it out
     278  // for debuging clear it out
     279  memset(space[which_space], 0, space_size[which_space]);
    269280  free(space[which_space]);
    270281
    271   space[which_space]=(char *)new_space;
    272   free_space[which_space]=((char *)new_space)+
    273          (((uint8_t *)free_space[GC_SPACE])-((uint8_t *)space[GC_SPACE]));
    274   current_space=old_space;
    275 }
    276 
     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 TracChangeset for help on using the changeset viewer.