src/ebisp/gc.c

   1 #include "system/stacktrace.h"
   2 #include <stdio.h>
   3 #include <stdlib.h>
   4 #include <string.h>
   5
   6 #include "builtins.h"
   7 #include "expr.h"
   8 #include "gc.h"
   9 #include "system/lt.h"
  10
  11 #define GC_INITIAL_CAPACITY 256
  12
  13 struct Gc
  14 {
  15     Lt *lt;
  16     struct Expr *exprs;
  17     int *visited;
  18     size_t size;
  19     size_t capacity;
  20 };
  21
  22 static intptr_t value_of_expr(struct Expr expr)
  23 {
  24     if (expr.type == EXPR_CONS) {
  25         return (intptr_t) expr.cons;
  26     } else if (expr.type == EXPR_ATOM) {
  27         return (intptr_t) expr.atom;
  28     } else {
  29         return 0;
  30     }
  31 }
  32
  33 static int compare_exprs(const void *a, const void *b)
  34 {
  35     trace_assert(a);
  36     trace_assert(b);
  37
  38     const intptr_t ptr_a = value_of_expr(*(const struct Expr *)a);
  39     const intptr_t ptr_b = value_of_expr(*(const struct Expr *)b);
  40     const intptr_t d = ptr_b - ptr_a;
  41
  42     if (d < 0) {
  43         return -1;
  44     } else if (d > 0) {
  45         return 1;
  46     } else {
  47         return 0;
  48     }
  49 }
  50
  51 Gc *create_gc(void)
  52 {
  53     Lt *lt = create_lt();
  54
  55     Gc *gc = PUSH_LT(lt, calloc(1, sizeof(Gc)), free);
  56     if (gc == NULL) {
  57         RETURN_LT(lt, NULL);
  58     }
  59     gc->lt = lt;
  60
  61     gc->exprs = PUSH_LT(lt, calloc(GC_INITIAL_CAPACITY, sizeof(struct Expr)), free);
  62     if (gc->exprs == NULL) {
  63         RETURN_LT(lt, NULL);
  64     }
  65
  66     gc->visited = PUSH_LT(lt, calloc(GC_INITIAL_CAPACITY, sizeof(int)), free);
  67     if (gc->visited == NULL) {
  68         RETURN_LT(lt, NULL);
  69     }
  70
  71     gc->size = 0;
  72     gc->capacity = GC_INITIAL_CAPACITY;
  73
  74     return gc;
  75 }
  76
  77 void destroy_gc(Gc *gc)
  78 {
  79     trace_assert(gc);
  80
  81     for (size_t i = 0; i < gc->size; ++i) {
  82         destroy_expr(gc->exprs[i]);
  83     }
  84
  85     RETURN_LT0(gc->lt);
  86 }
  87
  88 int gc_add_expr(Gc *gc, struct Expr expr)
  89 {
  90     trace_assert(gc);
  91
  92     if (gc->size >= gc->capacity) {
  93         const size_t new_capacity = gc->capacity * 2;
  94         struct Expr *const new_exprs = realloc(
  95             gc->exprs,
  96             sizeof(struct Expr) * new_capacity);
  97
  98         if (new_exprs == NULL) {
  99             return -1;
 100         }
 101
 102         int *const new_visited = realloc(
 103             gc->visited,
 104             sizeof(int) * new_capacity);
 105
 106         if (new_visited == NULL) {
 107             return -1;
 108         }
 109
 110         gc->capacity = new_capacity;
 111         gc->exprs = REPLACE_LT(gc->lt, gc->exprs, new_exprs);
 112         gc->visited = REPLACE_LT(gc->lt, gc->visited, new_visited);
 113     }
 114
 115     gc->exprs[gc->size++] = expr;
 116
 117     return 0;
 118 }
 119
 120 static long int gc_find_expr(Gc *gc, struct Expr expr)
 121 {
 122     trace_assert(gc);
 123     (void) expr;
 124
 125     struct Expr *result =
 126         (struct Expr *) bsearch(&expr, gc->exprs, gc->size,
 127                                 sizeof(struct Expr), compare_exprs);
 128
 129     if (result == NULL) {
 130         return -1;
 131     }
 132
 133     return (long int) (result - gc->exprs);
 134 }
 135
 136 static void gc_traverse_expr(Gc *gc, struct Expr root)
 137 {
 138     trace_assert(gc);
 139     trace_assert(root.type != EXPR_VOID);
 140     const long int root_index = gc_find_expr(gc, root);
 141     if (root_index < 0) {
 142         fprintf(stderr, "GC tried to collect something that was not registered\n");
 143         print_expr_as_sexpr(stderr, root);
 144         fprintf(stderr, "\n");
 145         trace_assert(root_index >= 0);
 146     }
 147
 148     if (gc->visited[root_index]) {
 149         return;
 150     }
 151
 152     gc->visited[root_index] = 1;
 153
 154     if (cons_p(root)) {
 155         gc_traverse_expr(gc, root.cons->car);
 156         gc_traverse_expr(gc, root.cons->cdr);
 157     } else if (root.type == EXPR_ATOM
 158                && root.atom->type == ATOM_LAMBDA) {
 159         gc_traverse_expr(gc, root.atom->lambda.args_list);
 160         gc_traverse_expr(gc, root.atom->lambda.body);
 161         gc_traverse_expr(gc, root.atom->lambda.envir);
 162     }
 163 }
 164
 165 void gc_collect(Gc *gc, struct Expr root)
 166 {
 167     trace_assert(gc);
 168     (void) root;
 169
 170     /* Sort gc->exprs O(nlogn) */
 171     qsort(gc->exprs, gc->size, sizeof(struct Expr), compare_exprs);
 172
 173     /* Defragment O(n) */
 174     while(gc->size > 0 && gc->exprs[gc->size - 1].type == EXPR_VOID) {
 175         gc->size--;
 176     }
 177
 178     /* Initialize visited array O(n) */
 179     memset(gc->visited, 0, sizeof(int) * gc->size);
 180
 181     /* Traverse root O(nlogn)  */
 182     gc_traverse_expr(gc, root);
 183
 184     /* Dealloc unvisted O(n)   */
 185     for (size_t i = 0; i < gc->size; ++i) {
 186         if (!gc->visited[i]) {
 187             destroy_expr(gc->exprs[i]);
 188             gc->exprs[i] = void_expr();
 189         }
 190     }
 191 }
 192
 193 void gc_inspect(const Gc *gc)
 194 {
 195     for (size_t i = 0; i < gc->size; ++i) {
 196         if (gc->exprs[i].type == EXPR_VOID) {
 197             printf(".");
 198         } else {
 199             printf("+");
 200         }
 201     }
 202     printf("\n");
 203 }