Add support for (strong) boxes, value vectors, and byte strings.
This commit is contained in:
parent
a464397e64
commit
61b83a1293
76
gc.c
76
gc.c
|
|
@ -5,6 +5,7 @@
|
|||
#include <stdbool.h>
|
||||
#include <stdio.h>
|
||||
#include <stdlib.h>
|
||||
#include <string.h>
|
||||
#include <time.h>
|
||||
|
||||
#ifndef NDEBUG
|
||||
|
|
@ -20,14 +21,17 @@ typedef uintptr_t value_t;
|
|||
/* Object: aaaaaaaa aaaaaaaa aaaaaaaa aaaaaa10 */
|
||||
/* Fixnum: snnnnnnn nnnnnnnn nnnnnnnn nnnnnnn1 */
|
||||
|
||||
#define NIL ((value_t)0)
|
||||
|
||||
/* Special values (1 <= n < 1024) */
|
||||
/* Special values (0 <= n < 1024) */
|
||||
/* These correspond to pairs within the first page of memory */
|
||||
#define SPECIAL_VALUE(n) ((value_t)(4*n))
|
||||
#define MAX_SPECIAL SPECIAL_VALUE(1023)
|
||||
|
||||
#define NIL SPECIAL_VALUE(0)
|
||||
#define BROKEN_HEART SPECIAL_VALUE(1)
|
||||
#define TYPE_TAG_BOX SPECIAL_VALUE(2)
|
||||
#define TYPE_TAG_VECTOR SPECIAL_VALUE(3)
|
||||
#define TYPE_TAG_BYTESTR SPECIAL_VALUE(4)
|
||||
|
||||
typedef struct pair
|
||||
{
|
||||
|
|
@ -44,6 +48,20 @@ typedef struct object
|
|||
} payload;
|
||||
} object_t;
|
||||
|
||||
typedef struct vector
|
||||
{
|
||||
value_t tag;
|
||||
size_t size;
|
||||
value_t elements[0];
|
||||
} vector_t;
|
||||
|
||||
typedef struct byte_string
|
||||
{
|
||||
value_t tag;
|
||||
size_t size;
|
||||
uint8_t bytes[0];
|
||||
} byte_string_t;
|
||||
|
||||
typedef struct gc_root
|
||||
{
|
||||
value_t value;
|
||||
|
|
@ -81,7 +99,7 @@ static inline value_t pair_value(pair_t *p)
|
|||
return (value_t)p;
|
||||
}
|
||||
|
||||
static inline value_t object_value(object_t *obj)
|
||||
static inline value_t object_value(void *obj)
|
||||
{
|
||||
return (value_t)obj | 2;
|
||||
}
|
||||
|
|
@ -237,11 +255,26 @@ static void transfer_object(value_t *value)
|
|||
{
|
||||
switch (obj->tag)
|
||||
{
|
||||
#if 0
|
||||
case TYPE_TAG_VECTOR:
|
||||
{
|
||||
const vector_t *vec = (const vector_t*)obj;
|
||||
const size_t nbytes = sizeof(vector_t) + sizeof(value_t) * vec->size;
|
||||
vector_t *newvec = (vector_t*)gc_alloc(nbytes);
|
||||
memcpy(newvec, vec, nbytes);
|
||||
new_value = object_value(newvec);
|
||||
}
|
||||
break;
|
||||
#endif
|
||||
default: /* pair or compatible */
|
||||
case TYPE_TAG_BYTESTR:
|
||||
{
|
||||
const byte_string_t *str = (const byte_string_t*)obj;
|
||||
const size_t nbytes = sizeof(byte_string_t) + str->size;
|
||||
byte_string_t *newstr = (byte_string_t*)gc_alloc(nbytes);
|
||||
memcpy(newstr, str, nbytes);
|
||||
new_value = object_value(newstr);
|
||||
}
|
||||
break;
|
||||
case TYPE_TAG_BOX:
|
||||
default: /* pair */
|
||||
{
|
||||
pair_t *p = (pair_t*)gc_alloc(sizeof(pair_t));
|
||||
const pair_t *q = (const pair_t*)obj;
|
||||
|
|
@ -250,14 +283,7 @@ static void transfer_object(value_t *value)
|
|||
//debug(("Moved pair from 0x%0.8X to 0x%0.8X.\n", q, p));
|
||||
|
||||
/* Keep the original tag bits (pair or object) */
|
||||
#if 0
|
||||
if (is_pair(*value))
|
||||
new_value = pair_value(p);
|
||||
else
|
||||
new_value = object_value((object_t*)p);
|
||||
#else
|
||||
new_value = pair_value(p) | (*value & 2);
|
||||
#endif
|
||||
}
|
||||
break;
|
||||
}
|
||||
|
|
@ -288,16 +314,26 @@ static inline size_t transfer_children(object_t *obj)
|
|||
{
|
||||
switch (obj->tag)
|
||||
{
|
||||
#if 0 /* Don't support other kinds of GC objects yet */
|
||||
case TYPE_TAG_VECTOR:
|
||||
{
|
||||
return sizeof(*obj) +
|
||||
sizeof(value_t) * from_fixnum(obj->payload.values[0]);
|
||||
}
|
||||
#endif
|
||||
default:
|
||||
vector_t *vec = (vector_t*)obj;
|
||||
const intptr_t nelem = from_fixnum(vec->size);
|
||||
|
||||
for (intptr_t i = 0; i < nelem; ++i)
|
||||
{
|
||||
transfer_object(&vec->elements[i]);
|
||||
}
|
||||
|
||||
return sizeof(vector_t) + (nelem * sizeof(value_t));
|
||||
}
|
||||
case TYPE_TAG_BYTESTR:
|
||||
{
|
||||
const byte_string_t *str = (const byte_string_t*)obj;
|
||||
return sizeof(byte_string_t) + from_fixnum(str->size);
|
||||
}
|
||||
case TYPE_TAG_BOX:
|
||||
default: /* pair */
|
||||
{
|
||||
/* Object is a pair or compatible type (e.g. box) */
|
||||
pair_t *p = (pair_t*)obj;
|
||||
transfer_object(&p->car);
|
||||
transfer_object(&p->cdr);
|
||||
|
|
|
|||
Loading…
Reference in New Issue