Compare commits

..

11 Commits

Author SHA1 Message Date
Aryadev Chavali
7f2dcc3ad2 alisp.org: mark TODOs 2026-03-05 17:32:52 +00:00
Aryadev Chavali
4bc615ab29 lisp_print: print verbose logs for lisp types on VERBOSE_LOGS=2 2026-03-05 17:32:52 +00:00
Aryadev Chavali
fc602f1664 allocator: free_list -> free_vec 2026-03-05 17:32:52 +00:00
Aryadev Chavali
30a87d4a1b some small updates 2026-03-05 17:32:52 +00:00
Aryadev Chavali
9940651ac0 alloc: arena_t -> alloc_t
arena_t doesn't really make sense given we also have a free list.
Better to name it generic.
2026-03-05 17:32:52 +00:00
Aryadev Chavali
be0a6dd0c8 allocator: arena_make now takes nodes off the free list first. 2026-03-05 17:32:52 +00:00
Aryadev Chavali
9a91511e48 sys: plug in allocator 2026-03-05 17:32:52 +00:00
Aryadev Chavali
f9a044f631 allocator: implement a basic allocator 2026-03-05 17:32:52 +00:00
Aryadev Chavali
0e75b541df vec: vec_try_append
Essentially a method to attempt to append data but without doing any
reallocation - stay within the bounds of the capacity.
2026-03-05 17:32:52 +00:00
Aryadev Chavali
e6e501c5a3 lisp: tag_generic, tag_sizeof, and lisp_sizeof 2026-03-05 17:32:52 +00:00
Aryadev Chavali
a79f60a203 lisp: split lisp into lisp and sys
Generic definition of tagged pointers, along with simple
constructor/destructors should be in lisp.h for use by other headers.

sys.h on the other hand contains all the general system methods.
2026-03-05 17:32:52 +00:00
14 changed files with 608 additions and 290 deletions

View File

@@ -6,20 +6,21 @@ TEST=$(DIST)/test.out
LDFLAGS= LDFLAGS=
GFLAGS=-Wall -Wextra -Wpedantic -Werror -std=c23 -I./include/ GFLAGS=-Wall -Wextra -Wpedantic -Werror -std=c23 -I./include/
DFLAGS=-ggdb -fsanitize=address -fsanitize=undefined -DVERBOSE_LOGS=1 DFLAGS=-ggdb -fsanitize=address -fsanitize=undefined
RFLAGS=-O3 RFLAGS=-O3
MODE=release MODE=release
ifeq ($(MODE), release) ifeq ($(MODE), release)
CFLAGS=$(GFLAGS) $(RFLAGS) CFLAGS=$(GFLAGS) $(RFLAGS)
else ifeq ($(MODE), debug) else ifeq ($(MODE), debug)
CFLAGS=$(GFLAGS) $(DFLAGS) CFLAGS=$(GFLAGS) $(DFLAGS) -DVERBOSE_LOGS=1
else ifeq ($(MODE), full) else ifeq ($(MODE), full)
CFLAGS=$(GFLAGS) $(DFLAGS) -DTEST_VERBOSE=1 CFLAGS=$(GFLAGS) $(DFLAGS) -DVERBOSE_LOGS=2 -DTEST_VERBOSE=1
endif endif
# Units to compile # Units to compile
UNITS=src/sv.c src/vec.c src/stream.c src/symtable.c src/tag.c src/lisp.c src/reader.c UNITS=src/sv.c src/vec.c src/stream.c src/symtable.c src/lisp.c src/allocator.c \
src/sys.c src/reader.c
OBJECTS:=$(patsubst src/%.c, $(DIST)/%.o, $(UNITS)) OBJECTS:=$(patsubst src/%.c, $(DIST)/%.o, $(UNITS))
TEST_UNITS=test/main.c TEST_UNITS=test/main.c

View File

@@ -84,7 +84,7 @@ Scheme doesn't have it. Should we implement this?
- Unmanaged objects are allocations we do as part of the runtime. - Unmanaged objects are allocations we do as part of the runtime.
These are things that we expect to have near infinite lifetimes These are things that we expect to have near infinite lifetimes
(such as the symbol table, vector of allocated objects, etc). (such as the symbol table, vector of allocated objects, etc).
*** TODO Design an allocator *** DONE Design an allocator
We'll need an allocator for all our managed objects. Requirements: We'll need an allocator for all our managed objects. Requirements:
- Stable pointers (memory that has already been allocated should be - Stable pointers (memory that has already been allocated should be
free to utilise via the same pointer for the lifetime of the free to utilise via the same pointer for the lifetime of the
@@ -92,14 +92,15 @@ We'll need an allocator for all our managed objects. Requirements:
- Able to tag allocations as unused (i.e. "free") and able to reuse - Able to tag allocations as unused (i.e. "free") and able to reuse
these allocations these allocations
- This will link into the garbage collector, which should yield a - This will link into the garbage collector, which should yield a
sequence of objects that should be "freed". sequence of objects that were previously tagged as unfree and
should be "freed".
- Able to allocate all the managed types we have - Able to allocate all the managed types we have
**** TODO Design allocation data structures **** DONE Design allocation data structures
**** TODO Design allocation methods for different lisp types **** DONE Design allocation methods for different lisp types
- Conses
- Vectors
- Strings (when implemented) - Strings (when implemented)
**** TODO Design allocation freeing methods ***** DONE Conses
***** DONE Vectors
**** DONE Design allocation freeing method
*** TODO Design garbage collection scheme :gc: *** TODO Design garbage collection scheme :gc:
Really, regardless of what I do, we need to have some kind of garbage Really, regardless of what I do, we need to have some kind of garbage
collection header on whatever managed objects we allocate. We need to collection header on whatever managed objects we allocate. We need to

View File

@@ -8,6 +8,7 @@
#ifndef ALISP_H #ifndef ALISP_H
#define ALISP_H #define ALISP_H
#include <alisp/allocator.h>
#include <alisp/base.h> #include <alisp/base.h>
#include <alisp/lisp.h> #include <alisp/lisp.h>
#include <alisp/reader.h> #include <alisp/reader.h>

57
include/alisp/allocator.h Normal file
View File

@@ -0,0 +1,57 @@
/* allocator.h: Lisp Allocator
* Created: 2026-02-12
* Author: Aryadev Chavali
* License: See end of file
* Commentary:
*/
#ifndef ALLOCATOR_H
#define ALLOCATOR_H
#include <alisp/lisp.h>
#include <alisp/vec.h>
#define ALLOC_PAGE_DEFAULT_SIZE 512
typedef struct
{
u64 references;
tag_t tag : 8;
} alloc_metadata_t;
typedef struct
{
alloc_metadata_t metadata;
u8 data[];
} alloc_node_t;
typedef struct
{
vec_t data;
} page_t;
typedef struct
{
vec_t pages;
vec_t free_vec;
} alloc_t;
lisp_t *alloc_make(alloc_t *, tag_t type);
void alloc_delete(alloc_t *, lisp_t *);
u64 alloc_cost(alloc_t *);
void alloc_free(alloc_t *);
#endif
/* Copyright (C) 2026 Aryadev Chavali
* This program is distributed in the hope that it will be useful, but WITHOUT
* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
* FOR A PARTICULAR PURPOSE. See the GNU General Public License Version 2 for
* details.
* You may distribute and modify this code under the terms of the GNU General
* Public License Version 2, which you should have received a copy of along with
* this program. If not, please go to <https://www.gnu.org/licenses/>.
*/

View File

@@ -65,33 +65,7 @@ lisp_t *tag_int(const i64);
lisp_t *tag_sym(const char *); lisp_t *tag_sym(const char *);
lisp_t *tag_cons(const cons_t *); lisp_t *tag_cons(const cons_t *);
lisp_t *tag_vec(const vec_t *); lisp_t *tag_vec(const vec_t *);
lisp_t *tag_generic(void *, tag_t);
/// System context
typedef struct
{
vec_t conses;
vec_t vectors;
u64 num_conses, num_vectors;
} sys_mem_t;
typedef struct
{
sys_mem_t memory;
sym_table_t symtable;
} sys_t;
void sys_init(sys_t *);
lisp_t *sys_alloc(sys_t *, tag_t type);
void sys_free(sys_t *);
// Debugging function: provides total memory usage from system.
u64 sys_cost(sys_t *);
/// Constructors and destructors
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 *);
i64 as_int(lisp_t *); i64 as_int(lisp_t *);
char *as_sym(lisp_t *); char *as_sym(lisp_t *);
@@ -101,13 +75,9 @@ vec_t *as_vec(lisp_t *);
#define CAR(L) (as_cons(L)->car) #define CAR(L) (as_cons(L)->car)
#define CDR(L) (as_cons(L)->cdr) #define CDR(L) (as_cons(L)->cdr)
lisp_t *car(lisp_t *);
lisp_t *cdr(lisp_t *);
void lisp_free(lisp_t *);
void lisp_free_rec(lisp_t *);
void lisp_print(FILE *, lisp_t *); void lisp_print(FILE *, lisp_t *);
u64 tag_sizeof(tag_t);
u64 lisp_sizeof(lisp_t *);
#endif #endif

View File

@@ -8,8 +8,8 @@
#ifndef READER_H #ifndef READER_H
#define READER_H #define READER_H
#include <alisp/lisp.h>
#include <alisp/stream.h> #include <alisp/stream.h>
#include <alisp/sys.h>
typedef enum typedef enum
{ {

53
include/alisp/sys.h Normal file
View File

@@ -0,0 +1,53 @@
/* sys.h: System context and constructors
* Created: 2026-02-12
* Author: Aryadev Chavali
* License: See end of file
* Commentary:
*/
#ifndef SYS_H
#define SYS_H
#include <alisp/allocator.h>
#include <alisp/lisp.h>
/// System context
typedef struct
{
alloc_t memory;
sym_table_t symtable;
} sys_t;
void sys_init(sys_t *);
lisp_t *sys_alloc(sys_t *, tag_t type);
void sys_free(sys_t *);
// Debugging function: provides total memory usage from system.
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 *car(lisp_t *);
lisp_t *cdr(lisp_t *);
void lisp_free(lisp_t *);
void lisp_free_rec(lisp_t *);
#endif
/* Copyright (C) 2026 Aryadev Chavali
* This program is distributed in the hope that it will be useful, but WITHOUT
* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
* FOR A PARTICULAR PURPOSE. See the GNU General Public License Version 2 for
* details.
* You may distribute and modify this code under the terms of the GNU General
* Public License Version 2, which you should have received a copy of along with
* this program. If not, please go to <https://www.gnu.org/licenses/>.
*/

View File

@@ -36,7 +36,10 @@ void vec_init(vec_t *, u64);
void vec_free(vec_t *); void vec_free(vec_t *);
u8 *vec_data(vec_t *); u8 *vec_data(vec_t *);
// Append, possibly reallocating memory
void vec_append(vec_t *, const void *const, u64); void vec_append(vec_t *, const void *const, u64);
// Try to append without allocating memory
bool vec_try_append(vec_t *, const void *const, u64);
void vec_ensure_free(vec_t *, u64); void vec_ensure_free(vec_t *, u64);
void vec_clone(vec_t *, vec_t *); void vec_clone(vec_t *, vec_t *);

212
src/allocator.c Normal file
View File

@@ -0,0 +1,212 @@
/* allocator.c: Allocator implementations
* Created: 2026-02-12
* Author: Aryadev Chavali
* License: See end of file
* Commentary:
*/
#include <stdlib.h>
#include <alisp/allocator.h>
#include <alisp/lisp.h>
#include <alisp/vec.h>
#include <string.h>
page_t *make_page(u64 size)
{
page_t *page = calloc(1, sizeof(*page));
vec_init(&page->data, MAX(size, ALLOC_PAGE_DEFAULT_SIZE));
return page;
}
alloc_node_t *make_node(page_t *page, tag_t type)
{
alloc_node_t *node = NULL;
u64 size = sizeof(*node);
switch (type)
{
case TAG_CONS:
size += sizeof(cons_t);
break;
case TAG_VEC:
size += sizeof(vec_t);
break;
case TAG_NIL:
case TAG_INT:
case TAG_SYM:
default:
FAIL("Unreachable");
return node;
}
// We must ensure size is a multiple of 8 for alignment purposes
size = (size & 0b111) == 0 ? size : size + (8 - (size & 0b111));
if (!vec_try_append(&page->data, NULL, size))
return NULL;
node = (alloc_node_t *)(vec_data(&page->data) + page->data.size - size);
node->metadata = (alloc_metadata_t){.references = 0, .tag = type};
return node;
}
alloc_node_t *lisp_to_node(lisp_t *lisp)
{
void *raw_ptr = NULL;
switch (get_tag(lisp))
{
case TAG_CONS:
raw_ptr = as_cons(lisp);
break;
case TAG_VEC:
raw_ptr = as_vec(lisp);
break;
case TAG_NIL: // These shouldn't be allocated
case TAG_INT:
case TAG_SYM:
default:
FAIL("Unreachable");
return NIL;
}
alloc_node_t *node = raw_ptr;
return &node[-1];
}
lisp_t *alloc_make(alloc_t *alloc, tag_t type)
{
switch (type)
{
case TAG_CONS:
case TAG_VEC:
break;
case TAG_NIL: // These shouldn't be allocated
case TAG_INT:
case TAG_SYM:
default:
FAIL("Unreachable");
return NIL;
}
// We want to try to fill this node with an allocation of this type.
alloc_node_t *node = NULL;
// Try to get something from the free vector
u64 free_vec_size = VEC_SIZE(&alloc->free_vec, alloc_node_t *);
for (u64 i = 0; i < free_vec_size; ++i)
{
alloc_node_t **nodeptr = &VEC_GET(&alloc->free_vec, i, alloc_node_t *);
// Skip any nodes that don't have the right type.
if (nodeptr[0]->metadata.tag != type)
continue;
assert("Expected free node to have no references" &&
nodeptr[0]->metadata.references == 0);
// Pop this node off the free vector by swapping it with the last item and
// decrementing the size of the vector.
alloc_node_t **lastptr =
&VEC_GET(&alloc->free_vec, free_vec_size - 1, alloc_node_t *);
alloc_node_t *val = *nodeptr;
*nodeptr = *lastptr;
*lastptr = val;
// Decrement the size of the free vector
alloc->free_vec.size -= sizeof(val);
// Then use that valid (and now unused) node as our return.
node = *lastptr;
goto end;
}
// We couldn't get anything from the free vector, so try to allocate a fresh
// one against one of the pages.
for (u64 i = 0; i < VEC_SIZE(&alloc->pages, page_t *); ++i)
{
page_t *page = VEC_GET(&alloc->pages, i, page_t *);
node = make_node(page, type);
if (node)
goto end;
}
// There aren't any pages we can allocate against, so we need to make a new
// page.
page_t *page = make_page(0);
vec_append(&alloc->pages, &page, sizeof(page));
node = make_node(page, type);
end:
if (!node)
FAIL("Unexpected issue with allocating to a verifiably good page");
return tag_generic(node->data, type);
}
void alloc_delete(alloc_t *alloc, lisp_t *lisp)
{
alloc_node_t *node = lisp_to_node(lisp);
assert(node && node->metadata.references == 0);
vec_append(&alloc->free_vec, &node, sizeof(node));
}
u64 alloc_cost(alloc_t *alloc)
{
u64 total_size = alloc->pages.size;
for (u64 i = 0; i < VEC_SIZE(&alloc->pages, page_t *); ++i)
{
page_t *page = VEC_GET(&alloc->pages, i, page_t *);
total_size += page->data.size;
}
return total_size;
}
void alloc_free(alloc_t *alloc)
{
for (u64 i = 0; i < VEC_SIZE(&alloc->pages, page_t *); ++i)
{
page_t *page = VEC_GET(&alloc->pages, i, page_t *);
// Iterate through every alloc_node in this page
for (u64 j = 0; j < VEC_SIZE(&page->data, u8);)
{
alloc_node_t *node = (alloc_node_t *)(vec_data(&page->data) + j);
u64 next = sizeof(*node) + tag_sizeof(node->metadata.tag);
switch (node->metadata.tag)
{
case TAG_CONS:
// Do nothing - will be cleaned by overall vec free anyway
break;
case TAG_VEC:
vec_free((vec_t *)node->data);
break;
case TAG_NIL:
case TAG_INT:
case TAG_SYM:
default:
FAIL("Unreachable");
}
j += next;
}
// Each page was allocated on the heap.
vec_free(&page->data);
free(page);
}
vec_free(&alloc->pages);
vec_free(&alloc->free_vec);
memset(alloc, 0, sizeof(*alloc));
}
/* Copyright (C) 2026 Aryadev Chavali
* This program is distributed in the hope that it will be useful, but WITHOUT
* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
* FOR A PARTICULAR PURPOSE. See the GNU General Public License Version 2 for
* details.
* You may distribute and modify this code under the terms of the GNU General
* Public License Version 2, which you should have received a copy of along with
* this program. If not, please go to <https://www.gnu.org/licenses/>.
*/

View File

@@ -10,175 +10,82 @@
#include <alisp/lisp.h> #include <alisp/lisp.h>
void sys_init(sys_t *sys) lisp_t *tag_int(i64 i)
{ {
memset(sys, 0, sizeof(*sys)); return TAG((u64)i, INT);
} }
lisp_t *sys_alloc(sys_t *sys, tag_t type) lisp_t *tag_sym(const char *str)
{
return TAG((u64)str, SYM);
}
lisp_t *tag_vec(const vec_t *vec)
{
return TAG((u64)vec, VEC);
}
lisp_t *tag_cons(const cons_t *cons)
{
return TAG((u64)cons, CONS);
}
lisp_t *tag_generic(void *ptr, tag_t type)
{ {
switch (type) switch (type)
{ {
case TAG_CONS:
{
cons_t *cons = calloc(1, sizeof(*cons));
lisp_t *lisp = tag_cons(cons);
vec_append(&sys->memory.conses, &lisp, sizeof(&lisp));
sys->memory.num_conses++;
return lisp;
}
case TAG_VEC:
{
vec_t *vec = calloc(1, sizeof(*vec));
lisp_t *lisp = tag_vec(vec);
vec_append(&sys->memory.vectors, &lisp, sizeof(&lisp));
sys->memory.num_vectors++;
return lisp;
}
// Shouldn't be registered
case TAG_NIL: case TAG_NIL:
return NIL;
case TAG_INT: case TAG_INT:
return tag_int((i64)ptr);
case TAG_SYM: case TAG_SYM:
return tag_sym(ptr);
case TAG_CONS:
return tag_cons(ptr);
case TAG_VEC:
return tag_vec(ptr);
default: default:
FAIL("Unreachable"); FAIL("Unreachable");
}
return NIL; return NIL;
} }
u64 sys_cost(sys_t *sys)
{
u64 vec_capacity = 0;
for (u64 i = 0; i < sys->memory.num_vectors; ++i)
{
lisp_t *vec = VEC_GET(&sys->memory.vectors, i, lisp_t *);
vec_capacity += as_vec(vec)->capacity;
}
return sym_table_cost(&sys->symtable) +
(sys->memory.num_conses * sizeof(cons_t)) + vec_capacity;
} }
void sys_free(sys_t *sys) tag_t get_tag(const lisp_t *lisp)
{ {
sym_table_free(&sys->symtable); static_assert(NUM_TAGS == 5);
if (!lisp)
return TAG_NIL;
else if (IS_TAG(lisp, INT))
return TAG_INT;
// Iterate through each cell of memory currently allocated and free them return (u64)lisp & 0xFF;
for (size_t i = 0; i < VEC_SIZE(&sys->memory.conses, lisp_t **); ++i)
{
lisp_t *allocated = VEC_GET(&sys->memory.conses, i, lisp_t *);
lisp_free(allocated);
} }
// Iterate through each cell of memory currently allocated and free them i64 as_int(lisp_t *obj)
for (size_t i = 0; i < VEC_SIZE(&sys->memory.vectors, lisp_t **); ++i)
{ {
lisp_t *allocated = VEC_GET(&sys->memory.vectors, i, lisp_t *); assert(IS_TAG(obj, INT));
lisp_free(allocated); u64 p_obj = (u64)obj;
return UNTAG(p_obj, INT) | // Delete the tag
(NTH_BYTE(p_obj, 7) & 0x80) << 56 // duplicate the MSB (preserve sign)
;
} }
// Free the containers char *as_sym(lisp_t *obj)
vec_free(&sys->memory.conses); {
vec_free(&sys->memory.vectors); assert(IS_TAG(obj, SYM));
return (char *)UNTAG(obj, SYM);
// Ensure no one treats this as active in any sense
memset(sys, 0, sizeof(*sys));
} }
lisp_t *make_int(i64 i) cons_t *as_cons(lisp_t *obj)
{ {
return tag_int(i); assert(IS_TAG(obj, CONS));
return (cons_t *)UNTAG(obj, CONS);
} }
lisp_t *cons(sys_t *sys, lisp_t *car, lisp_t *cdr) vec_t *as_vec(lisp_t *obj)
{ {
lisp_t *cons = sys_alloc(sys, TAG_CONS); assert(IS_TAG(obj, VEC));
CAR(cons) = car; return (vec_t *)UNTAG(obj, VEC);
CDR(cons) = cdr;
return cons;
}
lisp_t *make_vec(sys_t *sys, u64 capacity)
{
lisp_t *vec = sys_alloc(sys, TAG_VEC);
vec_init(as_vec(vec), capacity);
return vec;
}
lisp_t *intern(sys_t *sys, sv_t sv)
{
const char *str = sym_table_find(&sys->symtable, sv);
return tag_sym(str);
}
lisp_t *car(lisp_t *lsp)
{
if (!IS_TAG(lsp, CONS))
return NIL;
else
return CAR(lsp);
}
lisp_t *cdr(lisp_t *lsp)
{
if (!IS_TAG(lsp, CONS))
return NIL;
else
return CDR(lsp);
}
void lisp_free(lisp_t *item)
{
switch (get_tag(item))
{
case TAG_CONS:
// Delete the cons
free(as_cons(item));
break;
case TAG_VEC:
{
vec_t *vec = as_vec(item);
vec_free(vec);
free(vec);
break;
}
case TAG_NIL:
case TAG_INT:
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)
{
switch (get_tag(item))
{
case TAG_CONS:
{
lisp_free_rec(car(item));
lisp_free_rec(cdr(item));
free(as_cons(item));
break;
}
case TAG_VEC:
{
vec_t *vec = as_vec(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);
}
vec_free(vec);
free(vec);
break;
}
case TAG_NIL:
case TAG_INT:
case TAG_SYM:
case NUM_TAGS:
// shouldn't be dealt with (either constant or dealt with elsewhere)
break;
}
} }
void lisp_print(FILE *fp, lisp_t *lisp) void lisp_print(FILE *fp, lisp_t *lisp)
@@ -191,26 +98,26 @@ void lisp_print(FILE *fp, lisp_t *lisp)
fprintf(fp, "NIL"); fprintf(fp, "NIL");
break; break;
case TAG_INT: case TAG_INT:
#if VERBOSE_LOGS #if VERBOSE_LOGS == 2
fprintf(fp, "INT["); fprintf(fp, "INT[");
#endif #endif
fprintf(fp, "%ld", as_int(lisp)); fprintf(fp, "%ld", as_int(lisp));
#if VERBOSE_LOGS #if VERBOSE_LOGS == 2
fprintf(fp, "]"); fprintf(fp, "]");
#endif #endif
break; break;
case TAG_SYM: case TAG_SYM:
#if VERBOSE_LOGS #if VERBOSE_LOGS == 2
fprintf(fp, "SYM["); fprintf(fp, "SYM[");
#endif #endif
fprintf(fp, "%s", as_sym(lisp)); fprintf(fp, "%s", as_sym(lisp));
#if VERBOSE_LOGS #if VERBOSE_LOGS == 2
fprintf(fp, "]"); fprintf(fp, "]");
#endif #endif
break; break;
case TAG_CONS: case TAG_CONS:
{ {
#if VERBOSE_LOGS #if VERBOSE_LOGS == 2
fprintf(fp, "LIST["); fprintf(fp, "LIST[");
#else #else
fprintf(fp, "("); fprintf(fp, "(");
@@ -238,7 +145,7 @@ void lisp_print(FILE *fp, lisp_t *lisp)
break; break;
} }
} }
#if VERBOSE_LOGS #if VERBOSE_LOGS == 2
fprintf(fp, "]"); fprintf(fp, "]");
#else #else
fprintf(fp, ")"); fprintf(fp, ")");
@@ -247,7 +154,7 @@ void lisp_print(FILE *fp, lisp_t *lisp)
} }
case TAG_VEC: case TAG_VEC:
{ {
#if VERBOSE_LOGS #if VERBOSE_LOGS == 2
fprintf(fp, "VEC["); fprintf(fp, "VEC[");
#else #else
fprintf(fp, "["); fprintf(fp, "[");
@@ -264,7 +171,7 @@ void lisp_print(FILE *fp, lisp_t *lisp)
} }
} }
#if VERBOSE_LOGS #if VERBOSE_LOGS == 2
fprintf(fp, "]"); fprintf(fp, "]");
#else #else
fprintf(fp, "]"); fprintf(fp, "]");
@@ -278,6 +185,31 @@ void lisp_print(FILE *fp, lisp_t *lisp)
} }
} }
u64 tag_sizeof(tag_t tag)
{
switch (tag)
{
case TAG_NIL:
return 0;
case TAG_INT:
case TAG_SYM:
return sizeof(lisp_t *);
case TAG_CONS:
return sizeof(cons_t);
case TAG_VEC:
return sizeof(vec_t);
case NUM_TAGS:
default:
FAIL("Unreachable");
return 0;
}
}
u64 lisp_sizeof(lisp_t *lisp)
{
return tag_sizeof(get_tag(lisp));
}
/* Copyright (C) 2025, 2026 Aryadev Chavali /* Copyright (C) 2025, 2026 Aryadev Chavali
* This program is distributed in the hope that it will be useful, but WITHOUT * This program is distributed in the hope that it will be useful, but WITHOUT

156
src/sys.c Normal file
View File

@@ -0,0 +1,156 @@
/* sys.c: System implementation
* Created: 2026-02-12
* Author: Aryadev Chavali
* License: See end of file
* Commentary:
*/
#include <stdlib.h>
#include <string.h>
#include <alisp/sys.h>
void sys_init(sys_t *sys)
{
memset(sys, 0, sizeof(*sys));
}
lisp_t *sys_alloc(sys_t *sys, tag_t type)
{
switch (type)
{
case TAG_CONS:
case TAG_VEC:
return alloc_make(&sys->memory, type);
// Shouldn't be allocated
case TAG_NIL:
case TAG_INT:
case TAG_SYM:
default:
FAIL("Unreachable");
}
return NIL;
}
u64 sys_cost(sys_t *sys)
{
return alloc_cost(&sys->memory) + sym_table_cost(&sys->symtable);
}
void sys_free(sys_t *sys)
{
sym_table_free(&sys->symtable);
alloc_free(&sys->memory);
memset(sys, 0, sizeof(*sys));
}
lisp_t *make_int(i64 i)
{
return tag_int(i);
}
lisp_t *cons(sys_t *sys, lisp_t *car, lisp_t *cdr)
{
lisp_t *cons = sys_alloc(sys, TAG_CONS);
CAR(cons) = car;
CDR(cons) = cdr;
return cons;
}
lisp_t *make_vec(sys_t *sys, u64 capacity)
{
lisp_t *vec = sys_alloc(sys, TAG_VEC);
vec_init(as_vec(vec), capacity);
return vec;
}
lisp_t *intern(sys_t *sys, sv_t sv)
{
const char *str = sym_table_find(&sys->symtable, sv);
return tag_sym(str);
}
lisp_t *car(lisp_t *lsp)
{
if (!IS_TAG(lsp, CONS))
return NIL;
else
return CAR(lsp);
}
lisp_t *cdr(lisp_t *lsp)
{
if (!IS_TAG(lsp, CONS))
return NIL;
else
return CDR(lsp);
}
void lisp_free(lisp_t *item)
{
switch (get_tag(item))
{
case TAG_CONS:
// Delete the cons
free(as_cons(item));
break;
case TAG_VEC:
{
vec_t *vec = as_vec(item);
vec_free(vec);
free(vec);
break;
}
case TAG_NIL:
case TAG_INT:
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)
{
switch (get_tag(item))
{
case TAG_CONS:
{
lisp_free_rec(car(item));
lisp_free_rec(cdr(item));
free(as_cons(item));
break;
}
case TAG_VEC:
{
vec_t *vec = as_vec(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);
}
vec_free(vec);
free(vec);
break;
}
case TAG_NIL:
case TAG_INT:
case TAG_SYM:
case NUM_TAGS:
// shouldn't be dealt with (either constant or dealt with elsewhere)
break;
}
}
/* Copyright (C) 2026 Aryadev Chavali
* This program is distributed in the hope that it will be useful, but WITHOUT
* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
* FOR A PARTICULAR PURPOSE. See the GNU General Public License Version 2 for
* details.
* You may distribute and modify this code under the terms of the GNU General
* Public License Version 2, which you should have received a copy of along with
* this program. If not, please go to <https://www.gnu.org/licenses/>.
*/

View File

@@ -1,82 +0,0 @@
/* tag.c: Pointer tagging
* Created: 2025-08-19
* Author: Aryadev Chavali
* License: See end of file
* Commentary:
*/
#include <assert.h>
#include <stdlib.h>
#include <alisp/lisp.h>
lisp_t *tag_int(i64 i)
{
return TAG((u64)i, INT);
}
lisp_t *tag_sym(const char *str)
{
return TAG((u64)str, SYM);
}
lisp_t *tag_vec(const vec_t *vec)
{
return TAG((u64)vec, VEC);
}
lisp_t *tag_cons(const cons_t *cons)
{
return TAG((u64)cons, CONS);
}
tag_t get_tag(const lisp_t *lisp)
{
static_assert(NUM_TAGS == 5);
if (!lisp)
return TAG_NIL;
else if (IS_TAG(lisp, INT))
return TAG_INT;
return (u64)lisp & 0xFF;
}
i64 as_int(lisp_t *obj)
{
assert(IS_TAG(obj, INT));
u64 p_obj = (u64)obj;
return UNTAG(p_obj, INT) | // Delete the tag
(NTH_BYTE(p_obj, 7) & 0x80) << 56 // duplicate the MSB (preserve sign)
;
}
char *as_sym(lisp_t *obj)
{
assert(IS_TAG(obj, SYM));
return (char *)UNTAG(obj, SYM);
}
cons_t *as_cons(lisp_t *obj)
{
assert(IS_TAG(obj, CONS));
return (cons_t *)UNTAG(obj, CONS);
}
vec_t *as_vec(lisp_t *obj)
{
assert(IS_TAG(obj, VEC));
return (vec_t *)UNTAG(obj, VEC);
}
/* Copyright (C) 2025, 2026 Aryadev Chavali
* This program is distributed in the hope that it will be useful, but WITHOUT
* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
* FOR A PARTICULAR PURPOSE. See the GNU General Public License Version 2 for
* details.
* You may distribute and modify this code under the terms of the GNU General
* Public License Version 2, which you should have received a copy of along with
* this program. If not, please go to <https://www.gnu.org/licenses/>.
*/

View File

@@ -81,10 +81,24 @@ void vec_append(vec_t *vec, const void *const ptr, u64 size)
if (!vec) if (!vec)
return; return;
vec_ensure_free(vec, size); vec_ensure_free(vec, size);
if (ptr)
memcpy(vec_data(vec) + vec->size, ptr, size); memcpy(vec_data(vec) + vec->size, ptr, size);
vec->size += size; vec->size += size;
} }
bool vec_try_append(vec_t *vec, const void *const ptr, u64 size)
{
if (!vec || vec->capacity - vec->size < size)
return false;
if (ptr)
{
void *newptr = vec_data(vec) + vec->size;
memcpy(newptr, ptr, size);
}
vec->size += size;
return true;
}
void vec_clone(vec_t *dest, vec_t *src) void vec_clone(vec_t *dest, vec_t *src)
{ {
if (!src || !dest) if (!src || !dest)

View File

@@ -54,7 +54,7 @@ void stream_test_prologue(void)
void stream_test_epilogue(void) void stream_test_epilogue(void)
{ {
TEST_INFO("Freeing resources and deleting file `%s`\n", valid_filename); TEST_INFO("Deleting file `%s`\n", valid_filename);
assert(valid_fp); assert(valid_fp);
fclose(valid_fp); fclose(valid_fp);
remove(valid_filename); remove(valid_filename);