liamoc.net
the hito embeddable programming language
1#include "value.h"
2#include "env.h"
3#include "syntax.h"
4#include "util.h"
5#include <stdio.h>
6#include <stdlib.h>
7
8
9/* ---------------- GC management ---------------- */
10struct gc {
11 value_t *gc_list; // linked list of values
12};
13
14
15/* Mark bit stored in the high bit of `tag` */
16#define GC_MARK_BIT ((int)1 << (sizeof(int)*8 - 1))
17
18#define VALUE_TAG(v) ((v)->tag & ~GC_MARK_BIT)
19#define VALUE_MARKED(v) (((v)->tag & GC_MARK_BIT) != 0)
20#define VALUE_SET_MARK(v) ((v)->tag |= GC_MARK_BIT)
21#define VALUE_CLEAR_MARK(v) ((v)->tag &= ~GC_MARK_BIT)
22
23#define MARK_STACK_SIZE 256
24
25gc_t *gc_alloc(void) {
26 gc_t *gc = calloc(1,sizeof(gc_t));
27 if (gc == NULL)
28 die("Out of memory: cannot allocate gc");
29 return gc;
30}
31
32void gc_free(gc_t *gc) {
33 if (gc->gc_list != NULL)
34 die("Cannot free a gc arena that still has values in it!");
35 free(gc);
36}
37
38/* Allocate a new value, zero-initialized, linked into GC list */
39value_t *value_alloc(gc_t *gc) {
40 value_t *v = calloc(1, sizeof(value_t));
41 if (v == NULL)
42 die("Out of memory: cannot allocate value");
43 v->gc_next = gc->gc_list;
44 gc->gc_list = v;
45 return v;
46}
47
48value_t *value_alloc_bool(gc_t *gc, bool it) {
49 if (it) {
50 value_t *val = value_alloc(gc);
51 val->tag = VALUE_INT;
52 val->as.integer = 1;
53 return val;
54 } return NULL;
55}
56value_t *value_alloc_int(gc_t *gc, long it) {
57 value_t *val = value_alloc(gc);
58 val->tag = VALUE_INT;
59 val->as.integer = it;
60 return val;
61}
62value_t *value_alloc_float(gc_t *gc, double it) {
63 value_t *val = value_alloc(gc);
64 val->tag = VALUE_INT;
65 val->as.integer = it;
66 return val;
67}
68value_t *value_alloc_string(gc_t *gc, char *it, bool shared) {
69 value_t *val = value_alloc(gc);
70 val->tag = VALUE_STRING;
71 val->as.string.string = it;
72 val->as.string.shared = shared;
73 return val;
74}
75
76
77/* Recursive/stack-based marking function */
78static void mark_value(value_t *root) {
79 if (!root) return;
80
81 value_t *stack[MARK_STACK_SIZE];
82 size_t top = 0;
83
84 stack[top++] = root;
85
86 while (top > 0) {
87 value_t *v = stack[--top];
88 if (!v || VALUE_MARKED(v)) continue;
89
90 VALUE_SET_MARK(v);
91
92 switch (VALUE_TAG(v)) {
93 case VALUE_CONSTRUCTOR:
94 for (size_t i = 0; i < v->as.constructor.num_args; i++) {
95 value_t *child = v->as.constructor.args[i];
96 if (!child) continue;
97 if (top < MARK_STACK_SIZE) stack[top++] = child;
98 else mark_value(child); // fallback recursion
99 }
100 break;
101 case VALUE_ENV:
102 env_mark_values(v->as.env);
103 break;
104 case VALUE_CLOSURE: {
105 if (top < MARK_STACK_SIZE) stack[top++] = v->as.closure.env;
106 else mark_value(v->as.closure.env);
107 if (v->as.closure.next) {
108 if (top < MARK_STACK_SIZE) stack[top++] = v->as.closure.next;
109 else mark_value(v->as.closure.next);
110 }
111 }
112 break;
113 default:
114 break;
115 }
116 }
117}
118
119/* Public function to mark a single value */
120void value_mark_gc(value_t *v) {
121 mark_value(v);
122}
123
124/* Sweep unmarked values */
125static void sweep(gc_t *gc) {
126 value_t **ptr = &gc->gc_list;
127 while (*ptr) {
128 value_t *v = *ptr;
129 if (VALUE_MARKED(v)) {
130 VALUE_CLEAR_MARK(v);
131 ptr = &v->gc_next;
132 } else {
133 *ptr = v->gc_next;
134 switch (v->tag) {
135 case VALUE_STRING: if (!v->as.string.shared) {
136 free(v->as.string.string);
137 } break;
138 case VALUE_CONSTRUCTOR: if (v->as.constructor.args) {
139 free(v->as.constructor.args);
140 } break;
141 case VALUE_ENV:
142 env_free(v->as.env);
143 break;
144 default:
145 break;
146 }
147 free(v);
148 }
149 }
150}
151
152/* Trigger a GC cycle; caller must have marked roots */
153void value_gc(gc_t *gc) {
154 sweep(gc);
155}
156void value_debug_dump(value_t *it) {
157 if (it == NULL)
158 printf("nil");
159 else switch (it->tag) {
160 case VALUE_INT:
161 printf("%ld",it->as.integer);
162 break;
163 case VALUE_FLOAT:
164 printf("%f",it->as.floating);
165 break;
166 case VALUE_STRING:
167 printf("\"%s\"",it->as.string.string);
168 break;
169 case VALUE_ENV:
170 printf("<env {");
171 env_debug_dump(it->as.env);
172 printf("}");
173 break;
174 case VALUE_CLOSURE:
175 printf("[cl {");
176 if (it->as.closure.env) value_debug_dump(it->as.closure.env);
177 printf("} %zu:", it->as.closure.arity);
178 syntax_dump_expr(it->as.closure.body);
179 printf("|");
180 if (it->as.closure.next)
181 value_debug_dump(it->as.closure.next);
182 printf("]");
183 break;
184 case VALUE_CONSTRUCTOR:
185 printf("%s",it->as.constructor.name);
186 printf("(");
187 for (int i = 0; i < it->as.constructor.num_args; i++) {
188 value_debug_dump(it->as.constructor.args[i]);
189 if (i < it->as.constructor.num_args - 1)
190 printf(", ");
191 }
192 printf(")");
193 break;
194 default:
195 printf("!!%d!!", it->tag);
196 }
197
198
199}