forked from chrizel/moelisp
-
Notifications
You must be signed in to change notification settings - Fork 0
/
gc.c
110 lines (95 loc) · 2.57 KB
/
gc.c
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
#include <stdio.h>
#include "cons.h"
#include "gc.h"
#include "object.h"
#include "print.h"
static pobject gc_list = NIL;
pobject gc_add(pobject object)
{
if (object && (!is_symbol(object)))
gc_list = cons_new(object, gc_list);
return object;
}
void gc_free(pobject object)
{
pobject prev = NIL, cur;
/* look for the cons cell in gc_list for object */
cur = gc_list;
while (cur) {
if (cons_car(cur) == object)
break;
prev = cur;
cur = cons_cdr(cur);
}
/* set new gc_list connections and free the cur cons cell */
if (cur) {
if (prev)
cons_cdr_set(prev, cons_cdr(cur));
else
gc_list = cons_cdr(cur);
object_free(cur);
}
object_free(object);
}
static void gc_traverse(pobject env)
{
pobject object;
while (is_cons(env)) {
gc_flag_set(env, GC_FLAG_ON);
object = cons_car(env);
if (object && (gc_flag_get(object) == 0)) {
/*
printf("%p\n", object);
*/
gc_flag_set(object, GC_FLAG_ON);
/* XXX: dotted list support??? */
if (is_cons(object)) {
gc_traverse(object);
} else if (is_closure(object)) {
gc_traverse(object->data.closure.env);
gc_traverse(object->data.closure.code);
} else if (is_macro(object)) {
gc_traverse(object->data.macro.env);
gc_traverse(object->data.macro.code);
}
}
env = cons_cdr(env);
}
}
void gc_collect(pobject env)
{
int collected = 0;
pobject prev, cur, object;
/* set gc flag of all gc_list objects to 0 */
cur = gc_list;
while (cur) {
gc_flag_set(cons_car(cur), 0);
cur = cons_cdr(cur);
}
/* traverse environment and set gc flag of all objects to 1 */
gc_traverse(env);
/* go through gc_list a second time and free all all objects
* with flag 0 */
prev = NIL;
cur = gc_list;
while (cur) {
object = cons_car(cur);
if (gc_flag_get(object) == 0) {
object_free(object);
collected++;
if (prev) {
cons_cdr_set(prev, cons_cdr(cur));
object_free(cur);
cur = cons_cdr(prev);
} else {
gc_list = cons_cdr(cur);
object_free(cur);
cur = gc_list;
}
} else {
prev = cur;
cur = cons_cdr(cur);
}
}
printf("@@@ %d objects collected\n", collected);
}