allocator|lisp: support for strings

This commit is contained in:
2026-03-05 19:47:03 +00:00
parent bbb66d5fb1
commit 99448f6702
5 changed files with 82 additions and 35 deletions

View File

@@ -10,7 +10,7 @@
#include <stdio.h>
#include <alisp/symtable.h>
#include <alisp/string.h>
#include <alisp/vec.h>
#define NIL 0
@@ -31,7 +31,8 @@ typedef enum Tag
TAG_NIL = 0b00000000, // Container types (0 LSB)
TAG_CONS = 0b00000010,
TAG_VEC = 0b00000100,
NUM_TAGS = 5,
TAG_STR = 0b00000110,
NUM_TAGS = 6,
} tag_t;
// Some helper macros for tagging
@@ -47,17 +48,19 @@ typedef enum Tag
#define INT_MAX ((((i64)1) << (INT_BITS - 1)) - 1)
#define INT_MIN (-(INT_MAX + 1))
tag_t get_tag(const lisp_t *);
tag_t tag_get(const lisp_t *);
lisp_t *tag_smi(const i64);
lisp_t *tag_sym(const char *);
lisp_t *tag_cons(const cons_t *);
lisp_t *tag_vec(const vec_t *);
lisp_t *tag_str(const str_t *);
lisp_t *tag_generic(void *, tag_t);
i64 as_smi(lisp_t *);
char *as_sym(lisp_t *);
cons_t *as_cons(lisp_t *);
vec_t *as_vec(lisp_t *);
str_t *as_str(lisp_t *);
#define CAR(L) (as_cons(L)->car)
#define CDR(L) (as_cons(L)->cdr)

View File

@@ -27,15 +27,16 @@ u64 sys_cost(sys_t *);
/// Constructors and general Lisp API
lisp_t *make_int(i64);
lisp_t *make_vec(sys_t *, u64);
lisp_t *intern(sys_t *, sv_t);
lisp_t *cons(sys_t *, lisp_t *, lisp_t *);
lisp_t *make_vec(sys_t *, u64);
lisp_t *make_str(sys_t *, u64);
lisp_t *car(lisp_t *);
lisp_t *cdr(lisp_t *);
void lisp_free(lisp_t *);
void lisp_free_rec(lisp_t *);
void lisp_free(sys_t *, lisp_t *);
void lisp_free_rec(sys_t *, lisp_t *);
#endif

View File

@@ -23,6 +23,8 @@ alloc_node_t *make_node(page_t *page, tag_t type)
{
alloc_node_t *node = NULL;
u64 size = sizeof(*node);
static_assert(NUM_TAGS == 6);
switch (type)
{
case TAG_CONS:
@@ -31,6 +33,9 @@ alloc_node_t *make_node(page_t *page, tag_t type)
case TAG_VEC:
size += sizeof(vec_t);
break;
case TAG_STR:
size += sizeof(str_t);
break;
case TAG_NIL:
case TAG_SMI:
case TAG_SYM:
@@ -52,7 +57,9 @@ alloc_node_t *make_node(page_t *page, tag_t type)
alloc_node_t *lisp_to_node(lisp_t *lisp)
{
void *raw_ptr = NULL;
switch (get_tag(lisp))
static_assert(NUM_TAGS == 6);
switch (tag_get(lisp))
{
case TAG_CONS:
raw_ptr = as_cons(lisp);
@@ -60,6 +67,9 @@ alloc_node_t *lisp_to_node(lisp_t *lisp)
case TAG_VEC:
raw_ptr = as_vec(lisp);
break;
case TAG_STR:
raw_ptr = as_str(lisp);
break;
case TAG_NIL: // These shouldn't be allocated
case TAG_SMI:
case TAG_SYM:
@@ -74,10 +84,12 @@ alloc_node_t *lisp_to_node(lisp_t *lisp)
lisp_t *alloc_make(alloc_t *alloc, tag_t type)
{
static_assert(NUM_TAGS == 6);
switch (type)
{
case TAG_CONS:
case TAG_VEC:
case TAG_STR:
break;
case TAG_NIL: // These shouldn't be allocated
case TAG_SMI:
@@ -172,6 +184,8 @@ void alloc_free(alloc_t *alloc)
{
alloc_node_t *node = (alloc_node_t *)(vec_data(&page->data) + j);
u64 next = sizeof(*node) + tag_sizeof(node->metadata.tag);
static_assert(NUM_TAGS == 6);
switch (node->metadata.tag)
{
case TAG_CONS:
@@ -180,6 +194,9 @@ void alloc_free(alloc_t *alloc)
case TAG_VEC:
vec_free((vec_t *)node->data);
break;
case TAG_STR:
vec_free(&((str_t *)node->data)->data);
break;
case TAG_NIL:
case TAG_SMI:
case TAG_SYM:

View File

@@ -25,6 +25,11 @@ lisp_t *tag_vec(const vec_t *vec)
return TAG(vec, VEC);
}
lisp_t *tag_str(const str_t *str)
{
return TAG(str, STR);
}
lisp_t *tag_cons(const cons_t *cons)
{
return TAG(cons, CONS);
@@ -32,6 +37,7 @@ lisp_t *tag_cons(const cons_t *cons)
lisp_t *tag_generic(void *ptr, tag_t type)
{
static_assert(NUM_TAGS == 6);
switch (type)
{
case TAG_NIL:
@@ -44,15 +50,16 @@ lisp_t *tag_generic(void *ptr, tag_t type)
return tag_cons(ptr);
case TAG_VEC:
return tag_vec(ptr);
case TAG_STR:
return tag_str(ptr);
default:
FAIL("Unreachable");
return NIL;
}
}
tag_t get_tag(const lisp_t *lisp)
tag_t tag_get(const lisp_t *lisp)
{
static_assert(NUM_TAGS == 5);
return GET_TAG(lisp);
}
@@ -77,6 +84,12 @@ cons_t *as_cons(lisp_t *obj)
return (cons_t *)UNTAG(obj);
}
str_t *as_str(lisp_t *obj)
{
assert(IS_TAG(obj, STR));
return (str_t *)UNTAG(obj);
}
vec_t *as_vec(lisp_t *obj)
{
assert(IS_TAG(obj, VEC));
@@ -87,7 +100,8 @@ void lisp_print(FILE *fp, lisp_t *lisp)
{
if (!fp)
return;
switch (get_tag(lisp))
static_assert(NUM_TAGS == 6);
switch (tag_get(lisp))
{
case TAG_NIL:
fprintf(fp, "NIL");
@@ -173,7 +187,9 @@ void lisp_print(FILE *fp, lisp_t *lisp)
#endif
break;
}
case NUM_TAGS:
case TAG_STR:
TODO("Implement lisp_print for strings");
break;
default:
FAIL("Unreachable");
break;
@@ -182,6 +198,7 @@ void lisp_print(FILE *fp, lisp_t *lisp)
u64 tag_sizeof(tag_t tag)
{
static_assert(NUM_TAGS == 6);
switch (tag)
{
case TAG_NIL:
@@ -193,7 +210,8 @@ u64 tag_sizeof(tag_t tag)
return sizeof(cons_t);
case TAG_VEC:
return sizeof(vec_t);
case NUM_TAGS:
case TAG_STR:
return sizeof(str_t);
default:
FAIL("Unreachable");
return 0;
@@ -202,7 +220,7 @@ u64 tag_sizeof(tag_t tag)
u64 lisp_sizeof(lisp_t *lisp)
{
return tag_sizeof(get_tag(lisp));
return tag_sizeof(tag_get(lisp));
}
/* Copyright (C) 2025, 2026 Aryadev Chavali

View File

@@ -17,14 +17,16 @@ void sys_init(sys_t *sys)
lisp_t *sys_alloc(sys_t *sys, tag_t type)
{
static_assert(NUM_TAGS == 6);
switch (type)
{
case TAG_CONS:
case TAG_VEC:
case TAG_STR:
return alloc_make(&sys->memory, type);
// Shouldn't be allocated
case TAG_NIL:
case TAG_INT:
case TAG_SMI:
case TAG_SYM:
default:
FAIL("Unreachable");
@@ -64,6 +66,13 @@ lisp_t *make_vec(sys_t *sys, u64 capacity)
return vec;
}
lisp_t *make_str(sys_t *sys, u64 capacity)
{
lisp_t *str = sys_alloc(sys, TAG_STR);
vec_init(&as_str(str)->data, capacity);
return str;
}
lisp_t *intern(sys_t *sys, sv_t sv)
{
const char *str = sym_table_find(&sys->symtable, sv);
@@ -86,39 +95,35 @@ lisp_t *cdr(lisp_t *lsp)
return CDR(lsp);
}
void lisp_free(lisp_t *item)
void lisp_free(sys_t *sys, lisp_t *lisp)
{
switch (get_tag(item))
static_assert(NUM_TAGS == 6);
switch (tag_get(lisp))
{
case TAG_CONS:
// Delete the cons
free(as_cons(item));
break;
case TAG_STR:
case TAG_VEC:
{
vec_t *vec = as_vec(item);
vec_free(vec);
free(vec);
case TAG_CONS:
// Delete the underlying data
alloc_delete(&sys->memory, lisp);
break;
}
case TAG_NIL:
case TAG_SMI:
case TAG_SYM:
case NUM_TAGS:
// shouldn't be dealt with (either constant or dealt with elsewhere)
break;
}
}
void lisp_free_rec(lisp_t *item)
void lisp_free_rec(sys_t *sys, lisp_t *item)
{
switch (get_tag(item))
static_assert(NUM_TAGS == 6);
switch (tag_get(item))
{
case TAG_CONS:
{
lisp_free_rec(car(item));
lisp_free_rec(cdr(item));
free(as_cons(item));
lisp_free_rec(sys, car(item));
lisp_free_rec(sys, cdr(item));
lisp_free(sys, item);
break;
}
case TAG_VEC:
@@ -127,16 +132,19 @@ void lisp_free_rec(lisp_t *item)
for (size_t i = 0; i < VEC_SIZE(vec, lisp_t **); ++i)
{
lisp_t *allocated = VEC_GET(vec, i, lisp_t *);
lisp_free_rec(allocated);
lisp_free_rec(sys, allocated);
}
vec_free(vec);
free(vec);
lisp_free(sys, item);
break;
}
case TAG_STR:
{
lisp_free(sys, item);
break;
}
case TAG_NIL:
case TAG_SMI:
case TAG_SYM:
case NUM_TAGS:
// shouldn't be dealt with (either constant or dealt with elsewhere)
break;
}