Compare commits
11 Commits
79f53c7916
...
7f2dcc3ad2
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
7f2dcc3ad2 | ||
|
|
4bc615ab29 | ||
|
|
fc602f1664 | ||
|
|
30a87d4a1b | ||
|
|
9940651ac0 | ||
|
|
be0a6dd0c8 | ||
|
|
9a91511e48 | ||
|
|
f9a044f631 | ||
|
|
0e75b541df | ||
|
|
e6e501c5a3 | ||
|
|
a79f60a203 |
9
Makefile
9
Makefile
@@ -6,20 +6,21 @@ TEST=$(DIST)/test.out
|
||||
|
||||
LDFLAGS=
|
||||
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
|
||||
|
||||
MODE=release
|
||||
ifeq ($(MODE), release)
|
||||
CFLAGS=$(GFLAGS) $(RFLAGS)
|
||||
else ifeq ($(MODE), debug)
|
||||
CFLAGS=$(GFLAGS) $(DFLAGS)
|
||||
CFLAGS=$(GFLAGS) $(DFLAGS) -DVERBOSE_LOGS=1
|
||||
else ifeq ($(MODE), full)
|
||||
CFLAGS=$(GFLAGS) $(DFLAGS) -DTEST_VERBOSE=1
|
||||
CFLAGS=$(GFLAGS) $(DFLAGS) -DVERBOSE_LOGS=2 -DTEST_VERBOSE=1
|
||||
endif
|
||||
|
||||
# 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))
|
||||
|
||||
TEST_UNITS=test/main.c
|
||||
|
||||
15
alisp.org
15
alisp.org
@@ -84,7 +84,7 @@ Scheme doesn't have it. Should we implement this?
|
||||
- Unmanaged objects are allocations we do as part of the runtime.
|
||||
These are things that we expect to have near infinite lifetimes
|
||||
(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:
|
||||
- Stable pointers (memory that has already been allocated should be
|
||||
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
|
||||
these allocations
|
||||
- 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
|
||||
**** TODO Design allocation data structures
|
||||
**** TODO Design allocation methods for different lisp types
|
||||
- Conses
|
||||
- Vectors
|
||||
**** DONE Design allocation data structures
|
||||
**** DONE Design allocation methods for different lisp types
|
||||
- Strings (when implemented)
|
||||
**** TODO Design allocation freeing methods
|
||||
***** DONE Conses
|
||||
***** DONE Vectors
|
||||
**** DONE Design allocation freeing method
|
||||
*** TODO Design garbage collection scheme :gc:
|
||||
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
|
||||
|
||||
@@ -8,6 +8,7 @@
|
||||
#ifndef ALISP_H
|
||||
#define ALISP_H
|
||||
|
||||
#include <alisp/allocator.h>
|
||||
#include <alisp/base.h>
|
||||
#include <alisp/lisp.h>
|
||||
#include <alisp/reader.h>
|
||||
|
||||
57
include/alisp/allocator.h
Normal file
57
include/alisp/allocator.h
Normal 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/>.
|
||||
|
||||
*/
|
||||
@@ -65,33 +65,7 @@ lisp_t *tag_int(const i64);
|
||||
lisp_t *tag_sym(const char *);
|
||||
lisp_t *tag_cons(const cons_t *);
|
||||
lisp_t *tag_vec(const vec_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 *);
|
||||
lisp_t *tag_generic(void *, tag_t);
|
||||
|
||||
i64 as_int(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 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 *);
|
||||
u64 tag_sizeof(tag_t);
|
||||
u64 lisp_sizeof(lisp_t *);
|
||||
|
||||
#endif
|
||||
|
||||
|
||||
@@ -8,8 +8,8 @@
|
||||
#ifndef READER_H
|
||||
#define READER_H
|
||||
|
||||
#include <alisp/lisp.h>
|
||||
#include <alisp/stream.h>
|
||||
#include <alisp/sys.h>
|
||||
|
||||
typedef enum
|
||||
{
|
||||
|
||||
53
include/alisp/sys.h
Normal file
53
include/alisp/sys.h
Normal 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/>.
|
||||
|
||||
*/
|
||||
@@ -36,7 +36,10 @@ void vec_init(vec_t *, u64);
|
||||
void vec_free(vec_t *);
|
||||
u8 *vec_data(vec_t *);
|
||||
|
||||
// Append, possibly reallocating memory
|
||||
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_clone(vec_t *, vec_t *);
|
||||
|
||||
|
||||
212
src/allocator.c
Normal file
212
src/allocator.c
Normal 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/>.
|
||||
|
||||
*/
|
||||
254
src/lisp.c
254
src/lisp.c
@@ -10,175 +10,82 @@
|
||||
|
||||
#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)
|
||||
{
|
||||
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:
|
||||
return NIL;
|
||||
case TAG_INT:
|
||||
return tag_int((i64)ptr);
|
||||
case TAG_SYM:
|
||||
return tag_sym(ptr);
|
||||
case TAG_CONS:
|
||||
return tag_cons(ptr);
|
||||
case TAG_VEC:
|
||||
return tag_vec(ptr);
|
||||
default:
|
||||
FAIL("Unreachable");
|
||||
}
|
||||
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)
|
||||
{
|
||||
sym_table_free(&sys->symtable);
|
||||
|
||||
// Iterate through each cell of memory currently allocated and free them
|
||||
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
|
||||
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 *);
|
||||
lisp_free(allocated);
|
||||
}
|
||||
|
||||
// Free the containers
|
||||
vec_free(&sys->memory.conses);
|
||||
vec_free(&sys->memory.vectors);
|
||||
|
||||
// Ensure no one treats this as active in any sense
|
||||
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)
|
||||
tag_t get_tag(const lisp_t *lisp)
|
||||
{
|
||||
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;
|
||||
}
|
||||
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);
|
||||
}
|
||||
|
||||
void lisp_print(FILE *fp, lisp_t *lisp)
|
||||
@@ -191,26 +98,26 @@ void lisp_print(FILE *fp, lisp_t *lisp)
|
||||
fprintf(fp, "NIL");
|
||||
break;
|
||||
case TAG_INT:
|
||||
#if VERBOSE_LOGS
|
||||
#if VERBOSE_LOGS == 2
|
||||
fprintf(fp, "INT[");
|
||||
#endif
|
||||
fprintf(fp, "%ld", as_int(lisp));
|
||||
#if VERBOSE_LOGS
|
||||
#if VERBOSE_LOGS == 2
|
||||
fprintf(fp, "]");
|
||||
#endif
|
||||
break;
|
||||
case TAG_SYM:
|
||||
#if VERBOSE_LOGS
|
||||
#if VERBOSE_LOGS == 2
|
||||
fprintf(fp, "SYM[");
|
||||
#endif
|
||||
fprintf(fp, "%s", as_sym(lisp));
|
||||
#if VERBOSE_LOGS
|
||||
#if VERBOSE_LOGS == 2
|
||||
fprintf(fp, "]");
|
||||
#endif
|
||||
break;
|
||||
case TAG_CONS:
|
||||
{
|
||||
#if VERBOSE_LOGS
|
||||
#if VERBOSE_LOGS == 2
|
||||
fprintf(fp, "LIST[");
|
||||
#else
|
||||
fprintf(fp, "(");
|
||||
@@ -238,7 +145,7 @@ void lisp_print(FILE *fp, lisp_t *lisp)
|
||||
break;
|
||||
}
|
||||
}
|
||||
#if VERBOSE_LOGS
|
||||
#if VERBOSE_LOGS == 2
|
||||
fprintf(fp, "]");
|
||||
#else
|
||||
fprintf(fp, ")");
|
||||
@@ -247,7 +154,7 @@ void lisp_print(FILE *fp, lisp_t *lisp)
|
||||
}
|
||||
case TAG_VEC:
|
||||
{
|
||||
#if VERBOSE_LOGS
|
||||
#if VERBOSE_LOGS == 2
|
||||
fprintf(fp, "VEC[");
|
||||
#else
|
||||
fprintf(fp, "[");
|
||||
@@ -264,7 +171,7 @@ void lisp_print(FILE *fp, lisp_t *lisp)
|
||||
}
|
||||
}
|
||||
|
||||
#if VERBOSE_LOGS
|
||||
#if VERBOSE_LOGS == 2
|
||||
fprintf(fp, "]");
|
||||
#else
|
||||
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
|
||||
|
||||
* This program is distributed in the hope that it will be useful, but WITHOUT
|
||||
|
||||
156
src/sys.c
Normal file
156
src/sys.c
Normal 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/>.
|
||||
|
||||
*/
|
||||
82
src/tag.c
82
src/tag.c
@@ -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/>.
|
||||
|
||||
*/
|
||||
14
src/vec.c
14
src/vec.c
@@ -81,10 +81,24 @@ void vec_append(vec_t *vec, const void *const ptr, u64 size)
|
||||
if (!vec)
|
||||
return;
|
||||
vec_ensure_free(vec, size);
|
||||
if (ptr)
|
||||
memcpy(vec_data(vec) + vec->size, ptr, 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)
|
||||
{
|
||||
if (!src || !dest)
|
||||
|
||||
@@ -54,7 +54,7 @@ void stream_test_prologue(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);
|
||||
fclose(valid_fp);
|
||||
remove(valid_filename);
|
||||
|
||||
Reference in New Issue
Block a user