Something went wrong. Try again.
the hito embeddable programming language
Something went wrong. Try again.
123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199#include "value.h"#include "env.h"#include "syntax.h"#include "util.h"#include <stdio.h>#include <stdlib.h>
/* ---------------- GC management ---------------- */struct gc { value_t *gc_list; // linked list of values};
/* Mark bit stored in the high bit of `tag` */#define GC_MARK_BIT ((int)1 << (sizeof(int)*8 - 1))
#define VALUE_TAG(v) ((v)->tag & ~GC_MARK_BIT)#define VALUE_MARKED(v) (((v)->tag & GC_MARK_BIT) != 0)#define VALUE_SET_MARK(v) ((v)->tag |= GC_MARK_BIT)#define VALUE_CLEAR_MARK(v) ((v)->tag &= ~GC_MARK_BIT)
#define MARK_STACK_SIZE 256
gc_t *gc_alloc(void) { gc_t *gc = calloc(1,sizeof(gc_t)); if (gc == NULL) die("Out of memory: cannot allocate gc"); return gc;}
void gc_free(gc_t *gc) { if (gc->gc_list != NULL) die("Cannot free a gc arena that still has values in it!"); free(gc);}
/* Allocate a new value, zero-initialized, linked into GC list */value_t *value_alloc(gc_t *gc) { value_t *v = calloc(1, sizeof(value_t)); if (v == NULL) die("Out of memory: cannot allocate value"); v->gc_next = gc->gc_list; gc->gc_list = v; return v;}
value_t *value_alloc_bool(gc_t *gc, bool it) { if (it) { value_t *val = value_alloc(gc); val->tag = VALUE_INT; val->as.integer = 1; return val; } return NULL;}value_t *value_alloc_int(gc_t *gc, long it) { value_t *val = value_alloc(gc); val->tag = VALUE_INT; val->as.integer = it; return val;}value_t *value_alloc_float(gc_t *gc, double it) { value_t *val = value_alloc(gc); val->tag = VALUE_INT; val->as.integer = it; return val;}value_t *value_alloc_string(gc_t *gc, char *it, bool shared) { value_t *val = value_alloc(gc); val->tag = VALUE_STRING; val->as.string.string = it; val->as.string.shared = shared; return val;}
/* Recursive/stack-based marking function */static void mark_value(value_t *root) { if (!root) return; value_t *stack[MARK_STACK_SIZE]; size_t top = 0;
stack[top++] = root;
while (top > 0) { value_t *v = stack[--top]; if (!v || VALUE_MARKED(v)) continue;
VALUE_SET_MARK(v);
switch (VALUE_TAG(v)) { case VALUE_CONSTRUCTOR: for (size_t i = 0; i < v->as.constructor.num_args; i++) { value_t *child = v->as.constructor.args[i]; if (!child) continue; if (top < MARK_STACK_SIZE) stack[top++] = child; else mark_value(child); // fallback recursion } break; case VALUE_ENV: env_mark_values(v->as.env); break; case VALUE_CLOSURE: { if (top < MARK_STACK_SIZE) stack[top++] = v->as.closure.env; else mark_value(v->as.closure.env); if (v->as.closure.next) { if (top < MARK_STACK_SIZE) stack[top++] = v->as.closure.next; else mark_value(v->as.closure.next); } } break; default: break; } }}
/* Public function to mark a single value */void value_mark_gc(value_t *v) { mark_value(v);}
/* Sweep unmarked values */static void sweep(gc_t *gc) { value_t **ptr = &gc->gc_list; while (*ptr) { value_t *v = *ptr; if (VALUE_MARKED(v)) { VALUE_CLEAR_MARK(v); ptr = &v->gc_next; } else { *ptr = v->gc_next; switch (v->tag) { case VALUE_STRING: if (!v->as.string.shared) { free(v->as.string.string); } break; case VALUE_CONSTRUCTOR: if (v->as.constructor.args) { free(v->as.constructor.args); } break; case VALUE_ENV: env_free(v->as.env); break; default: break; } free(v); } }}
/* Trigger a GC cycle; caller must have marked roots */void value_gc(gc_t *gc) { sweep(gc);}void value_debug_dump(value_t *it) { if (it == NULL) printf("nil"); else switch (it->tag) { case VALUE_INT: printf("%ld",it->as.integer); break; case VALUE_FLOAT: printf("%f",it->as.floating); break; case VALUE_STRING: printf("\"%s\"",it->as.string.string); break; case VALUE_ENV: printf("<env {"); env_debug_dump(it->as.env); printf("}"); break; case VALUE_CLOSURE: printf("[cl {"); if (it->as.closure.env) value_debug_dump(it->as.closure.env); printf("} %zu:", it->as.closure.arity); syntax_dump_expr(it->as.closure.body); printf("|"); if (it->as.closure.next) value_debug_dump(it->as.closure.next); printf("]"); break; case VALUE_CONSTRUCTOR: printf("%s",it->as.constructor.name); printf("("); for (int i = 0; i < it->as.constructor.num_args; i++) { value_debug_dump(it->as.constructor.args[i]); if (i < it->as.constructor.num_args - 1) printf(", "); } printf(")"); break; default: printf("!!%d!!", it->tag); } }