gc.c

   1 /* file: "gc.c" */
   2
   3 /*
   4  * Copyright 2004-2009 by Marc Feeley and Vincent St-Amour, All Rights Reserved.
   5  */
   6
   7 #include "picobit-vm.h"
   8
   9 void init_ram_heap (void) {
  10   uint8 i;
  11   obj o = MAX_RAM_ENCODING;
  12
  13   free_list = 0;
  14
  15   while (o > (MIN_RAM_ENCODING + (glovars + 1) / 2)) {
  16     // we don't want to add globals to the free list, and globals occupy the
  17     // beginning of memory at the rate of 2 globals per word (car and cdr)
  18     ram_set_gc_tags (o, GC_TAG_UNMARKED);
  19     ram_set_car (o, free_list);
  20     free_list = o;
  21     o--;
  22   }
  23
  24   free_list_vec = MIN_VEC_ENCODING;
  25   ram_set_car (free_list_vec, 0);
  26   // each node of the free list must know the free length that follows it
  27   // this free length is stored in words, not in bytes
  28   // if we did count in bytes, the number might need more than 13 bits
  29   ram_set_cdr (free_list_vec, VEC_BYTES / 4);
  30
  31   for (i=0; i<glovars; i++)
  32     set_global (i, OBJ_FALSE);
  33
  34   arg1 = OBJ_FALSE;
  35   arg2 = OBJ_FALSE;
  36   arg3 = OBJ_FALSE;
  37   arg4 = OBJ_FALSE;
  38   cont = OBJ_FALSE;
  39   env  = OBJ_NULL;
  40 }
  41
  42
  43 void mark (obj temp) {
  44   /* mark phase */
  45
  46   obj stack;
  47   obj visit;
  48
  49   if (IN_RAM(temp)) {
  50     visit = NIL;
  51
  52   push:
  53
  54     stack = visit;
  55     visit = temp;
  56
  57     IF_GC_TRACE(printf ("push   stack=%d  visit=%d (tag=%d)\n", stack, visit, ram_get_gc_tags (visit)>>5));
  58
  59     if ((HAS_1_OBJECT_FIELD (visit) && ram_get_gc_tag0 (visit))
  60         || (HAS_2_OBJECT_FIELDS (visit)
  61             && (ram_get_gc_tags (visit) != GC_TAG_UNMARKED)))
  62       IF_GC_TRACE(printf ("case 1\n"));
  63     else {
  64       if (HAS_2_OBJECT_FIELDS(visit)) { // pairs and continuations
  65         IF_GC_TRACE(printf ("case 2\n"));
  66
  67       visit_field2:
  68
  69         temp = ram_get_cdr (visit);
  70
  71         if (IN_RAM(temp)) {
  72           IF_GC_TRACE(printf ("case 3\n"));
  73           ram_set_gc_tags (visit, GC_TAG_1_LEFT);
  74           ram_set_cdr (visit, stack);
  75           goto push;
  76         }
  77
  78         IF_GC_TRACE(printf ("case 4\n"));
  79
  80         goto visit_field1;
  81       }
  82
  83       if (HAS_1_OBJECT_FIELD(visit)) {
  84         IF_GC_TRACE(printf ("case 5\n"));
  85
  86       visit_field1:
  87
  88         // closures have the pointer in the cdr, not in the car as others
  89         if (RAM_CLOSURE(visit))
  90           temp = ram_get_cdr (visit);
  91         else
  92           temp = ram_get_car (visit);
  93
  94         if (IN_RAM(temp)) {
  95           IF_GC_TRACE(printf ("case 6\n"));
  96           ram_set_gc_tag0 (visit, GC_TAG_0_LEFT);
  97           if (RAM_CLOSURE(visit))
  98             ram_set_cdr (visit, stack);
  99           else
 100             ram_set_car (visit, stack);
 101
 102           goto push;
 103         }
 104
 105         IF_GC_TRACE(printf ("case 7\n"));
 106       }
 107       else
 108         IF_GC_TRACE(printf ("case 8\n"));
 109
 110       ram_set_gc_tag0 (visit, GC_TAG_0_LEFT);
 111     }
 112
 113   pop:
 114
 115     IF_GC_TRACE(printf ("pop    stack=%d  visit=%d (tag=%d)\n", stack, visit, ram_get_gc_tags (visit)>>6));
 116
 117     if (stack != NIL) {
 118       if (HAS_2_OBJECT_FIELDS(stack) && ram_get_gc_tag1 (stack)) {
 119         IF_GC_TRACE(printf ("case 9\n"));
 120
 121         temp = ram_get_cdr (stack);  /* pop through cdr */
 122         ram_set_cdr (stack, visit);
 123         visit = stack;
 124         stack = temp;
 125
 126         ram_set_gc_tag1(visit, GC_TAG_UNMARKED);
 127         // we unset the "1-left" bit
 128
 129         goto visit_field1;
 130       }
 131
 132       if (RAM_CLOSURE(stack)) {
 133         // closures have one object field, but it's in the cdr
 134         IF_GC_TRACE(printf ("case 10\n"));
 135
 136         temp = ram_get_cdr (stack);  /* pop through cdr */
 137         ram_set_cdr (stack, visit);
 138         visit = stack;
 139         stack = temp;
 140
 141         goto pop;
 142       }
 143
 144       IF_GC_TRACE(printf ("case 11\n"));
 145
 146       temp = ram_get_car (stack);  /* pop through car */
 147       ram_set_car (stack, visit);
 148       visit = stack;
 149       stack = temp;
 150
 151       goto pop;
 152     }
 153   }
 154 }
 155
 156 #ifdef DEBUG_GC
 157 int max_live = 0;
 158 #endif
 159
 160 void sweep (void) {
 161   /* sweep phase */
 162
 163 #ifdef DEBUG_GC
 164   int n = 0;
 165 #endif
 166
 167   obj visit = MAX_RAM_ENCODING;
 168
 169   free_list = 0;
 170
 171   while (visit >= (MIN_RAM_ENCODING + ((glovars + 1) / 2))) {
 172     // we don't want to sweep the global variables area
 173     if ((RAM_COMPOSITE(visit)
 174          && (ram_get_gc_tags (visit) == GC_TAG_UNMARKED)) // 2 mark bit
 175         || !(ram_get_gc_tags (visit) & GC_TAG_0_LEFT)) { // 1 mark bit
 176       /* unmarked? */
 177       if (RAM_VECTOR(visit)) {
 178         // when we sweep a vector, we also have to sweep its contents
 179         obj o = ram_get_cdr (visit);
 180         uint16 i = ram_get_car (visit); // number of elements
 181         ram_set_car (o, free_list_vec);
 182         ram_set_cdr (o, (i + 3) / 4); // free length, in words
 183         free_list_vec = o;
 184         // TODO merge free spaces
 185       }
 186       ram_set_car (visit, free_list);
 187       free_list = visit;
 188       }
 189     else {
 190       if (RAM_COMPOSITE(visit))
 191         ram_set_gc_tags (visit, GC_TAG_UNMARKED);
 192       else // only 1 mark bit to unset
 193         ram_set_gc_tag0 (visit, GC_TAG_UNMARKED);
 194 #ifdef DEBUG_GC
 195       n++;
 196 #endif
 197     }
 198     visit--;
 199   }
 200
 201 #ifdef DEBUG_GC
 202   if (n > max_live) {
 203     max_live = n;
 204     printf ("**************** memory needed = %d\n", max_live+1);
 205     fflush (stdout);
 206   }
 207 #endif
 208 }
 209
 210 void gc (void) {
 211   uint8 i;
 212
 213   IF_TRACE(printf("\nGC BEGINS\n"));
 214
 215   IF_GC_TRACE(printf("arg1\n"));
 216   mark (arg1);
 217   IF_GC_TRACE(printf("arg2\n"));
 218   mark (arg2);
 219   IF_GC_TRACE(printf("arg3\n"));
 220   mark (arg3);
 221   IF_GC_TRACE(printf("arg4\n"));
 222   mark (arg4);
 223   IF_GC_TRACE(printf("arg5\n"));
 224   mark (arg5);
 225   IF_GC_TRACE(printf("cont\n"));
 226   mark (cont);
 227   IF_GC_TRACE(printf("env\n"));
 228   mark (env);
 229
 230   IF_GC_TRACE(printf("globals\n"));
 231   for (i=0; i<glovars; i++)
 232     mark (get_global (i));
 233
 234   sweep ();
 235 }
 236
 237 obj alloc_ram_cell (void) {
 238   obj o;
 239
 240 #ifdef DEBUG_GC
 241   gc ();
 242 #endif
 243
 244   if (free_list == 0) {
 245 #ifndef DEBUG_GC
 246     gc ();
 247     if (free_list == 0)
 248 #endif
 249       ERROR("alloc_ram_cell", "memory is full");
 250   }
 251
 252   o = free_list;
 253
 254   free_list = ram_get_car (o);
 255
 256   return o;
 257 }
 258
 259 obj alloc_ram_cell_init (uint8 f0, uint8 f1, uint8 f2, uint8 f3) {
 260   obj o = alloc_ram_cell ();
 261
 262   ram_set_field0 (o, f0);
 263   ram_set_field1 (o, f1);
 264   ram_set_field2 (o, f2);
 265   ram_set_field3 (o, f3);
 266
 267   return o;
 268 }
 269
 270 obj alloc_vec_cell (uint16 n) {
 271   obj o = free_list_vec;
 272   obj prec = 0;
 273   uint8 gc_done = 0;
 274
 275 #ifdef DEBUG_GC
 276   gc ();
 277   gc_done = 1;
 278 #endif
 279
 280   while ((ram_get_cdr (o) * 4) < n) { // free space too small
 281     if (o == 0) { // no free space, or none big enough
 282       if (gc_done) // we gc'd, but no space is big enough for the vector
 283         ERROR("alloc_vec_cell", "no room for vector");
 284 #ifndef DEBUG_GC
 285       gc ();
 286       gc_done = 1;
 287 #endif
 288       o = free_list_vec;
 289       prec = 0;
 290       continue;
 291     } // TODO merge adjacent free spaces, maybe compact ?
 292     prec = o;
 293     o = ram_get_car (o);
 294   }
 295
 296   // case 1 : the new vector fills every free word advertized, we remove the
 297   //  node from the free list
 298   if (((ram_get_cdr(o) * 4) - n) < 4) {
 299     if (prec)
 300       ram_set_car (prec, ram_get_car (o));
 301     else
 302       free_list_vec = ram_get_car (o);
 303   }
 304   // case 2 : there is still some space left in the free section, create a new
 305   //  node to represent this space
 306   else {
 307     obj new_free = o + (n + 3)/4;
 308     if (prec)
 309       ram_set_car (prec, new_free);
 310     else
 311       free_list_vec = new_free;
 312     ram_set_car (new_free, ram_get_car (o));
 313     ram_set_cdr (new_free, ram_get_cdr (o) - (n + 3)/4);
 314   }
 315
 316   return o;
 317 }