Compare commits
2 Commits
7f2dcc3ad2
...
b93042fd27
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
b93042fd27 | ||
|
|
a50ca72b24 |
@@ -26,48 +26,35 @@ typedef struct
|
||||
/// Tagging system
|
||||
typedef enum Tag
|
||||
{
|
||||
TAG_NIL = 0b00000000, // Start of atomic types
|
||||
TAG_INT = 0b00000001, // Special tag so we can encode 63 bit integers
|
||||
TAG_SYM = 0b00000100,
|
||||
TAG_CONS = 0b00000010, // Start of container types
|
||||
TAG_VEC = 0b00000110,
|
||||
TAG_SMI = 0b00000001, // Atomic types
|
||||
TAG_SYM = 0b00000011,
|
||||
TAG_NIL = 0b00000000, // Container types (0 LSB)
|
||||
TAG_CONS = 0b00000010,
|
||||
TAG_VEC = 0b00000100,
|
||||
NUM_TAGS = 5,
|
||||
} tag_t;
|
||||
|
||||
static_assert(NUM_TAGS == 5, "Expected NUM_TAGS == 5 for enum SHIFT");
|
||||
enum Shift
|
||||
{
|
||||
SHIFT_INT = 1,
|
||||
SHIFT_SYM = 8,
|
||||
SHIFT_CONS = 8,
|
||||
SHIFT_VEC = 8,
|
||||
};
|
||||
|
||||
static_assert(NUM_TAGS == 5, "Expected NUM_TAGS == 5 for enum MASK");
|
||||
enum Mask
|
||||
{
|
||||
MASK_INT = 0b00000001,
|
||||
MASK_SYM = 0b11111111,
|
||||
MASK_CONS = 0b11111111,
|
||||
MASK_VEC = 0b11111111,
|
||||
};
|
||||
|
||||
// Some helper macros for tagging
|
||||
#define TAG(PTR, TYPE) ((lisp_t *)(((PTR) << SHIFT_##TYPE) | TAG_##TYPE))
|
||||
#define IS_TAG(PTR, TYPE) (((u64)(PTR) & MASK_##TYPE) == TAG_##TYPE)
|
||||
#define UNTAG(PTR, TYPE) (((u64)PTR) >> SHIFT_##TYPE)
|
||||
#define SHIFT_TAG (8)
|
||||
#define MASK_TAG ((1 << SHIFT_TAG) - 1)
|
||||
|
||||
#define INT_MAX ((((i64)1) << 62) - 1)
|
||||
#define INT_MIN (-(((i64)1) << 62))
|
||||
#define TAG(PTR, TYPE) ((lisp_t *)((((u64)(PTR)) << SHIFT_TAG) | TAG_##TYPE))
|
||||
#define UNTAG(PTR) (((u64)PTR) >> SHIFT_TAG)
|
||||
#define GET_TAG(PTR) ((tag_t)(((u64)(PTR)) & MASK_TAG))
|
||||
#define IS_TAG(PTR, TYPE) (GET_TAG(PTR) == TAG_##TYPE)
|
||||
|
||||
#define INT_BITS ((sizeof(i64) * 8) - SHIFT_TAG)
|
||||
#define INT_MAX ((((i64)1) << (INT_BITS - 1)) - 1)
|
||||
#define INT_MIN (-(INT_MAX + 1))
|
||||
|
||||
tag_t get_tag(const lisp_t *);
|
||||
lisp_t *tag_int(const i64);
|
||||
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_generic(void *, tag_t);
|
||||
|
||||
i64 as_int(lisp_t *);
|
||||
i64 as_smi(lisp_t *);
|
||||
char *as_sym(lisp_t *);
|
||||
cons_t *as_cons(lisp_t *);
|
||||
vec_t *as_vec(lisp_t *);
|
||||
|
||||
@@ -32,7 +32,7 @@ alloc_node_t *make_node(page_t *page, tag_t type)
|
||||
size += sizeof(vec_t);
|
||||
break;
|
||||
case TAG_NIL:
|
||||
case TAG_INT:
|
||||
case TAG_SMI:
|
||||
case TAG_SYM:
|
||||
default:
|
||||
FAIL("Unreachable");
|
||||
@@ -61,7 +61,7 @@ alloc_node_t *lisp_to_node(lisp_t *lisp)
|
||||
raw_ptr = as_vec(lisp);
|
||||
break;
|
||||
case TAG_NIL: // These shouldn't be allocated
|
||||
case TAG_INT:
|
||||
case TAG_SMI:
|
||||
case TAG_SYM:
|
||||
default:
|
||||
FAIL("Unreachable");
|
||||
@@ -80,7 +80,7 @@ lisp_t *alloc_make(alloc_t *alloc, tag_t type)
|
||||
case TAG_VEC:
|
||||
break;
|
||||
case TAG_NIL: // These shouldn't be allocated
|
||||
case TAG_INT:
|
||||
case TAG_SMI:
|
||||
case TAG_SYM:
|
||||
default:
|
||||
FAIL("Unreachable");
|
||||
@@ -181,7 +181,7 @@ void alloc_free(alloc_t *alloc)
|
||||
vec_free((vec_t *)node->data);
|
||||
break;
|
||||
case TAG_NIL:
|
||||
case TAG_INT:
|
||||
case TAG_SMI:
|
||||
case TAG_SYM:
|
||||
default:
|
||||
FAIL("Unreachable");
|
||||
|
||||
47
src/lisp.c
47
src/lisp.c
@@ -10,24 +10,24 @@
|
||||
|
||||
#include <alisp/lisp.h>
|
||||
|
||||
lisp_t *tag_int(i64 i)
|
||||
lisp_t *tag_smi(i64 i)
|
||||
{
|
||||
return TAG((u64)i, INT);
|
||||
return TAG(i, SMI);
|
||||
}
|
||||
|
||||
lisp_t *tag_sym(const char *str)
|
||||
{
|
||||
return TAG((u64)str, SYM);
|
||||
return TAG(str, SYM);
|
||||
}
|
||||
|
||||
lisp_t *tag_vec(const vec_t *vec)
|
||||
{
|
||||
return TAG((u64)vec, VEC);
|
||||
return TAG(vec, VEC);
|
||||
}
|
||||
|
||||
lisp_t *tag_cons(const cons_t *cons)
|
||||
{
|
||||
return TAG((u64)cons, CONS);
|
||||
return TAG(cons, CONS);
|
||||
}
|
||||
|
||||
lisp_t *tag_generic(void *ptr, tag_t type)
|
||||
@@ -35,9 +35,9 @@ lisp_t *tag_generic(void *ptr, tag_t type)
|
||||
switch (type)
|
||||
{
|
||||
case TAG_NIL:
|
||||
return NIL;
|
||||
case TAG_INT:
|
||||
return tag_int((i64)ptr);
|
||||
return TAG(ptr, NIL);
|
||||
case TAG_SMI:
|
||||
return tag_smi((i64)ptr);
|
||||
case TAG_SYM:
|
||||
return tag_sym(ptr);
|
||||
case TAG_CONS:
|
||||
@@ -53,39 +53,34 @@ lisp_t *tag_generic(void *ptr, tag_t type)
|
||||
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;
|
||||
return GET_TAG(lisp);
|
||||
}
|
||||
|
||||
i64 as_int(lisp_t *obj)
|
||||
i64 as_smi(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)
|
||||
;
|
||||
assert(IS_TAG(obj, SMI));
|
||||
u64 raw_obj = UNTAG(obj);
|
||||
u64 msb = (NTH_BYTE(raw_obj, 6) & 0x80) >> 7;
|
||||
msb = ((1LU << 8) - msb) << 56;
|
||||
return (i64)(raw_obj | msb);
|
||||
}
|
||||
|
||||
char *as_sym(lisp_t *obj)
|
||||
{
|
||||
assert(IS_TAG(obj, SYM));
|
||||
return (char *)UNTAG(obj, SYM);
|
||||
return (char *)UNTAG(obj);
|
||||
}
|
||||
|
||||
cons_t *as_cons(lisp_t *obj)
|
||||
{
|
||||
assert(IS_TAG(obj, CONS));
|
||||
return (cons_t *)UNTAG(obj, CONS);
|
||||
return (cons_t *)UNTAG(obj);
|
||||
}
|
||||
|
||||
vec_t *as_vec(lisp_t *obj)
|
||||
{
|
||||
assert(IS_TAG(obj, VEC));
|
||||
return (vec_t *)UNTAG(obj, VEC);
|
||||
return (vec_t *)UNTAG(obj);
|
||||
}
|
||||
|
||||
void lisp_print(FILE *fp, lisp_t *lisp)
|
||||
@@ -97,11 +92,11 @@ void lisp_print(FILE *fp, lisp_t *lisp)
|
||||
case TAG_NIL:
|
||||
fprintf(fp, "NIL");
|
||||
break;
|
||||
case TAG_INT:
|
||||
case TAG_SMI:
|
||||
#if VERBOSE_LOGS == 2
|
||||
fprintf(fp, "INT[");
|
||||
#endif
|
||||
fprintf(fp, "%ld", as_int(lisp));
|
||||
fprintf(fp, "%ld", as_smi(lisp));
|
||||
#if VERBOSE_LOGS == 2
|
||||
fprintf(fp, "]");
|
||||
#endif
|
||||
@@ -191,7 +186,7 @@ u64 tag_sizeof(tag_t tag)
|
||||
{
|
||||
case TAG_NIL:
|
||||
return 0;
|
||||
case TAG_INT:
|
||||
case TAG_SMI:
|
||||
case TAG_SYM:
|
||||
return sizeof(lisp_t *);
|
||||
case TAG_CONS:
|
||||
|
||||
@@ -111,7 +111,7 @@ read_err_t read_negative(sys_t *sys, stream_t *stream, lisp_t **ret)
|
||||
read_err_t err = read_int(sys, stream, ret);
|
||||
if (err)
|
||||
return err;
|
||||
i64 n = as_int(*ret);
|
||||
i64 n = as_smi(*ret);
|
||||
n *= -1;
|
||||
*ret = make_int(n);
|
||||
return READ_ERR_OK;
|
||||
|
||||
@@ -46,7 +46,7 @@ void sys_free(sys_t *sys)
|
||||
|
||||
lisp_t *make_int(i64 i)
|
||||
{
|
||||
return tag_int(i);
|
||||
return tag_smi(i);
|
||||
}
|
||||
|
||||
lisp_t *cons(sys_t *sys, lisp_t *car, lisp_t *cdr)
|
||||
@@ -102,7 +102,7 @@ void lisp_free(lisp_t *item)
|
||||
break;
|
||||
}
|
||||
case TAG_NIL:
|
||||
case TAG_INT:
|
||||
case TAG_SMI:
|
||||
case TAG_SYM:
|
||||
case NUM_TAGS:
|
||||
// shouldn't be dealt with (either constant or dealt with elsewhere)
|
||||
@@ -134,7 +134,7 @@ void lisp_free_rec(lisp_t *item)
|
||||
break;
|
||||
}
|
||||
case TAG_NIL:
|
||||
case TAG_INT:
|
||||
case TAG_SMI:
|
||||
case TAG_SYM:
|
||||
case NUM_TAGS:
|
||||
// shouldn't be dealt with (either constant or dealt with elsewhere)
|
||||
|
||||
@@ -23,7 +23,7 @@ void smi_test(void)
|
||||
{
|
||||
i64 in = ints[i];
|
||||
lisp_t *lisp = make_int(in);
|
||||
i64 out = as_int(lisp);
|
||||
i64 out = as_smi(lisp);
|
||||
|
||||
TEST(in == out, "%ld == %ld", in, out);
|
||||
}
|
||||
@@ -47,7 +47,7 @@ void smi_oob_test(void)
|
||||
{
|
||||
i64 in = ints[i];
|
||||
lisp_t *lisp = make_int(in);
|
||||
i64 out = as_int(lisp);
|
||||
i64 out = as_smi(lisp);
|
||||
|
||||
TEST(in != out, "%ld != %ld", in, out);
|
||||
}
|
||||
|
||||
Reference in New Issue
Block a user