From a79f60a203f3f42a6c3c21fccd7c0ee05de8c66e Mon Sep 17 00:00:00 2001 From: Aryadev Chavali Date: Thu, 12 Feb 2026 23:07:23 +0000 Subject: [PATCH] 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. --- Makefile | 2 +- include/alisp/lisp.h | 33 ------- include/alisp/reader.h | 2 +- include/alisp/sys.h | 59 +++++++++++++ src/lisp.c | 175 +++++++----------------------------- src/sys.c | 195 +++++++++++++++++++++++++++++++++++++++++ src/tag.c | 82 ----------------- 7 files changed, 287 insertions(+), 261 deletions(-) create mode 100644 include/alisp/sys.h create mode 100644 src/sys.c delete mode 100644 src/tag.c diff --git a/Makefile b/Makefile index d4c16fa..9985dc5 100644 --- a/Makefile +++ b/Makefile @@ -19,7 +19,7 @@ CFLAGS=$(GFLAGS) $(DFLAGS) -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/sys.c src/reader.c OBJECTS:=$(patsubst src/%.c, $(DIST)/%.o, $(UNITS)) TEST_UNITS=test/main.c diff --git a/include/alisp/lisp.h b/include/alisp/lisp.h index 3979b2a..ba77720 100644 --- a/include/alisp/lisp.h +++ b/include/alisp/lisp.h @@ -66,33 +66,6 @@ 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 *); - i64 as_int(lisp_t *); char *as_sym(lisp_t *); cons_t *as_cons(lisp_t *); @@ -101,12 +74,6 @@ 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 *); #endif diff --git a/include/alisp/reader.h b/include/alisp/reader.h index 30bc3c9..484b54a 100644 --- a/include/alisp/reader.h +++ b/include/alisp/reader.h @@ -8,8 +8,8 @@ #ifndef READER_H #define READER_H -#include #include +#include typedef enum { diff --git a/include/alisp/sys.h b/include/alisp/sys.h new file mode 100644 index 0000000..75b8e4d --- /dev/null +++ b/include/alisp/sys.h @@ -0,0 +1,59 @@ +/* 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 + +/// 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 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 . + + */ diff --git a/src/lisp.c b/src/lisp.c index 12ee334..4caf67c 100644 --- a/src/lisp.c +++ b/src/lisp.c @@ -10,175 +10,62 @@ #include -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) { - 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_INT: - case TAG_SYM: - default: - FAIL("Unreachable"); - } - return NIL; + return TAG((u64)str, SYM); } -u64 sys_cost(sys_t *sys) +lisp_t *tag_vec(const vec_t *vec) { - 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; + return TAG((u64)vec, VEC); } -void sys_free(sys_t *sys) +lisp_t *tag_cons(const cons_t *cons) { - 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)); + return TAG((u64)cons, CONS); } -lisp_t *make_int(i64 i) +tag_t get_tag(const lisp_t *lisp) { - return tag_int(i); + static_assert(NUM_TAGS == 5); + if (!lisp) + return TAG_NIL; + else if (IS_TAG(lisp, INT)) + return TAG_INT; + + return (u64)lisp & 0xFF; } -lisp_t *cons(sys_t *sys, lisp_t *car, lisp_t *cdr) +i64 as_int(lisp_t *obj) { - lisp_t *cons = sys_alloc(sys, TAG_CONS); - CAR(cons) = car; - CDR(cons) = cdr; - return cons; + 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) + ; } -lisp_t *make_vec(sys_t *sys, u64 capacity) +char *as_sym(lisp_t *obj) { - lisp_t *vec = sys_alloc(sys, TAG_VEC); - vec_init(as_vec(vec), capacity); - return vec; + assert(IS_TAG(obj, SYM)); + return (char *)UNTAG(obj, SYM); } -lisp_t *intern(sys_t *sys, sv_t sv) +cons_t *as_cons(lisp_t *obj) { - const char *str = sym_table_find(&sys->symtable, sv); - return tag_sym(str); + assert(IS_TAG(obj, CONS)); + return (cons_t *)UNTAG(obj, CONS); } -lisp_t *car(lisp_t *lsp) +vec_t *as_vec(lisp_t *obj) { - 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; - } + assert(IS_TAG(obj, VEC)); + return (vec_t *)UNTAG(obj, VEC); } void lisp_print(FILE *fp, lisp_t *lisp) diff --git a/src/sys.c b/src/sys.c new file mode 100644 index 0000000..c31fbfa --- /dev/null +++ b/src/sys.c @@ -0,0 +1,195 @@ +/* sys.c: System implementation + * Created: 2026-02-12 + * Author: Aryadev Chavali + * License: See end of file + * Commentary: + */ + +#include +#include + +#include + +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: + { + 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_INT: + case TAG_SYM: + 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) +{ + 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 . + + */ diff --git a/src/tag.c b/src/tag.c deleted file mode 100644 index 63e484e..0000000 --- a/src/tag.c +++ /dev/null @@ -1,82 +0,0 @@ -/* tag.c: Pointer tagging - * Created: 2025-08-19 - * Author: Aryadev Chavali - * License: See end of file - * Commentary: - */ - -#include -#include - -#include - -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 . - - */