src/ebisp/gc.c

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