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