native/gc.c

   1 #include "factor.h"
   2
   3 /* Stop-and-copy garbage collection using Cheney's algorithm. */
   4
   5 /* #define GC_DEBUG /* */
   6
   7 INLINE void gc_debug(char* msg, CELL x) {
   8 #ifdef GC_DEBUG
   9         printf("%s %d\n",msg,x);
  10 #endif
  11 }
  12
  13 /* Given a pointer to a pointer to oldspace, copy it to newspace. */
  14 CELL copy_untagged_object(CELL pointer, CELL size)
  15 {
  16         CELL newpointer = allot(size);
  17         memcpy(newpointer,pointer,size);
  18
  19         return newpointer;
  20 }
  21
  22 /*
  23 Given a pointer to a tagged pointer to oldspace, copy it to newspace.
  24 If the object has already been copied, return the forwarding
  25 pointer address without copying anything; otherwise, install
  26 a new forwarding pointer.
  27 */
  28 void copy_object(CELL* handle)
  29 {
  30         CELL pointer = *handle;
  31         CELL tag = TAG(pointer);
  32         CELL header, newpointer;
  33
  34         if(in_zone(active,pointer))
  35                 critical_error("copy_object given newspace ptr",pointer);
  36
  37         if(tag == FIXNUM_TYPE)
  38         {
  39                 /* convinience */
  40                 return;
  41         }
  42
  43         header = get(UNTAG(pointer));
  44
  45         if(TAG(header) == GC_COLLECTED)
  46         {
  47                 newpointer = UNTAG(header);
  48                 gc_debug("FORWARDING",newpointer);
  49         }
  50         else
  51         {
  52                 gc_debug("copy_object",pointer);
  53                 newpointer = copy_untagged_object(UNTAG(pointer),
  54                         object_size(pointer));
  55                 put(UNTAG(pointer),RETAG(newpointer,GC_COLLECTED));
  56         }
  57
  58         if(tag == GC_COLLECTED)
  59                 critical_error("installing forwarding pointer in newspace",newpointer);
  60
  61         *handle = RETAG(newpointer,tag);
  62 }
  63
  64 void collect_object(void)
  65 {
  66         CELL size = untagged_object_size(scan);
  67         gc_debug("collect_object",scan);
  68         gc_debug("collect_object size=",size);
  69
  70         switch(untag_header(get(scan)))
  71         {
  72         case WORD_TYPE:
  73                 collect_word((WORD*)scan);
  74                 break;
  75         case ARRAY_TYPE:
  76                 collect_array((ARRAY*)scan);
  77                 break;
  78         case VECTOR_TYPE:
  79                 collect_vector((VECTOR*)scan);
  80                 break;
  81         case SBUF_TYPE:
  82                 collect_sbuf((SBUF*)scan);
  83                 break;
  84         case HANDLE_TYPE:
  85                 collect_handle((HANDLE*)scan);
  86         }
  87
  88         scan += size;
  89 }
  90
  91 void collect_next(void)
  92 {
  93         gc_debug("collect_next",scan);
  94         gc_debug("collect_next header",get(scan));
  95         switch(TAG(get(scan)))
  96         {
  97         case HEADER_TYPE:
  98                 collect_object();
  99                 break;
 100         default:
 101                 copy_object(scan);
 102                 scan += CELLS;
 103                 break;
 104         }
 105 }
 106
 107 void copy_roots(void)
 108 {
 109         int i;
 110
 111         CELL ds_depth = env.ds - UNTAG(env.ds_bot);
 112         CELL cs_depth = env.cs - UNTAG(env.cs_bot);
 113
 114         gc_debug("collect_roots",scan);
 115         /* these three must be the first in the heap */
 116         copy_object(&empty);
 117         gc_debug("empty",empty);
 118         copy_object(&F);
 119         gc_debug("f",F);
 120         copy_object(&T);
 121         gc_debug("t",T);
 122         copy_object(&env.dt);
 123         copy_object(&env.ds_bot);
 124         env.ds = UNTAG(env.ds_bot) + ds_depth;
 125         copy_object(&env.cs_bot);
 126         env.cs = UNTAG(env.cs_bot) + cs_depth;
 127         copy_object(&env.cf);
 128         copy_object(&env.boot);
 129
 130         for(i = 0; i < USER_ENV; i++)
 131                 copy_object(&env.user[i]);
 132 }
 133
 134 void primitive_gc(void)
 135 {
 136         flip_zones();
 137         scan = active->here = active->base;
 138         copy_roots();
 139         while(scan < active->here)
 140         {
 141                 gc_debug("scan loop",scan);
 142                 collect_next();
 143         }
 144         gc_debug("gc done",0);
 145 }