Constructors and context -> sys

We can register memory we've allocated onto the heap into a ~sys_t~
instance for examination (read: garbage collection) later.  We can
also add items to the symbol table it has internally.
This commit is contained in:
2025-08-20 21:12:46 +01:00
parent 99396b0533
commit 3074ba5bab
6 changed files with 157 additions and 18 deletions

18
base.h
View File

@@ -102,22 +102,26 @@ typedef struct
{
lisp_t *memory;
sym_table_t symtable;
} context_t;
} sys_t;
void context_init(context_t *);
void context_cleanup(context_t *);
void sys_init(sys_t *);
void sys_register(sys_t *sys, lisp_t *ptr);
void sys_cleanup(sys_t *);
/// Constructors and destructors
lisp_t *make_int(i64 i);
lisp_t *intern(context_t *context, char *str);
lisp_t *cons(context_t *context, lisp_t *car, lisp_t *cdr);
lisp_t *make_vec(context_t *context, u64 capacity);
lisp_t *make_vec(sys_t *sys, u64 capacity);
lisp_t *intern(sys_t *sys, sv_t sv);
lisp_t *cons(sys_t *sys, lisp_t *car, lisp_t *cdr);
i64 as_int(lisp_t *);
char *as_sym(lisp_t *);
cons_t *as_cons(lisp_t *);
void *as_vec(lisp_t *);
#define CAR(L) (as_cons(L)->car)
#define CDR(L) (as_cons(L)->cdr)
/// Pointer tagging scheme for lisps
typedef enum Tag
@@ -153,6 +157,8 @@ enum Mask
#define INT_MAX ((1L << 62) - 1)
#define INT_MIN (-(1L << 62))
tag_t get_tag(lisp_t *lisp);
lisp_t *tag_int(i64 i);
lisp_t *tag_sym(char *str);
lisp_t *tag_cons(cons_t *cons);

View File

@@ -1,7 +1,7 @@
#!/usr/bin/env sh
CFLAGS="-Wall -Wextra -std=c11 -ggdb -fsanitize=address -fsanitize=undefined"
SRC="vec.c tag.c symtable.c main.c"
SRC="vec.c symtable.c tag.c constructor.c sys.c main.c"
OUT="alisp.out"
set -xe

48
constructor.c Normal file
View File

@@ -0,0 +1,48 @@
/* Copyright (C) 2025 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 Unlicense for details.
* You may distribute and modify this code under the terms of the Unlicense,
* which you should have received a copy of along with this program. If not,
* please go to <https://unlicense.org/>.
* Created: 2025-08-20
* Description: Lisp constructors/destructors
*/
#include <malloc.h>
#include "./base.h"
lisp_t *make_int(i64 i)
{
return tag_int(i);
}
lisp_t *cons(sys_t *sys, lisp_t *car, lisp_t *cdr)
{
cons_t *cons = calloc(1, sizeof(*cons));
cons->car = car;
cons->cdr = cdr;
lisp_t *lcons = tag_cons(cons);
sys_register(sys, lcons);
return lcons;
}
lisp_t *make_vec(sys_t *sys, u64 capacity)
{
lvec_t *lvec = calloc(1, sizeof(*lvec));
vec_make(&lvec->data, capacity);
lisp_t *ptr = tag_vec(lvec);
sys_register(sys, ptr);
return ptr;
}
lisp_t *intern(sys_t *sys, sv_t sv)
{
char *s = sym_table_find(&sys->symtable, sv);
return tag_sym(s);
}

14
main.c
View File

@@ -27,16 +27,8 @@ sv_t sv_copy(sv_t old)
int main(void)
{
i64 numbers[] = {
1, 1024, -200, 1LU << 32, INT_MAX, INT_MIN,
};
for (u64 i = 0; i < ARRSIZE(numbers); ++i)
{
i64 num = numbers[i];
lisp_t *lisp = tag_int(num);
i64 ret = as_int(lisp);
printf("%#16lx => %#16lx => %#16lx\n", num, lisp, ret);
}
sys_t sys;
sys_init(&sys);
sys_cleanup(&sys);
return 0;
}

77
sys.c Normal file
View File

@@ -0,0 +1,77 @@
/* Copyright (C) 2025 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 Unlicense for details.
* You may distribute and modify this code under the terms of the Unlicense,
* which you should have received a copy of along with this program. If not,
* please go to <https://unlicense.org/>.
* Created: 2025-08-20
* Description: System management
*/
#include "./base.h"
#include <assert.h>
#include <malloc.h>
#include <string.h>
void sys_init(sys_t *sys)
{
sys->memory = NIL;
sym_table_init(&sys->symtable);
}
void sys_register(sys_t *sys, lisp_t *ptr)
{
// Generate an unmanaged cons
cons_t *cons = calloc(1, sizeof(*cons));
cons->car = ptr;
cons->cdr = sys->memory;
sys->memory = tag_cons(cons);
}
void sys_cleanup(sys_t *sys)
{
static_assert(NUM_TAGS == 5);
sym_table_cleanup(&sys->symtable);
if (!sys->memory)
return;
// Iterate through each element of memory
for (lisp_t *cell = sys->memory, *next = CDR(cell); cell;
cell = next, next = CDR(cell))
{
// Only reason allocated exists is because we had to allocate memory on the
// heap for it. It's therefore
lisp_t *allocated = CAR(cell);
switch (get_tag(allocated))
{
case TAG_CONS:
// Delete the cons
free(as_cons(allocated));
break;
case TAG_VEC:
{
lvec_t *lvec = as_vec(allocated);
vec_free(&lvec->data);
free(lvec);
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;
}
// Then free the current cell
free(as_cons(cell));
}
memset(sys, 0, sizeof(*sys));
}

16
tag.c
View File

@@ -27,11 +27,27 @@ lisp_t *tag_sym(char *str)
return TAG((u64)str, SYM);
}
lisp_t *tag_vec(lvec_t *lvec)
{
return TAG((u64)lvec, VEC);
}
lisp_t *tag_cons(cons_t *cons)
{
return TAG((u64)cons, CONS);
}
tag_t get_tag(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));