factor/native/types.h

#define TAG_MASK 7
#define TAG_BITS 3
#define TAG(cell) ((CELL)(cell) & TAG_MASK)
#define RETAG(cell,tag) ((CELL)(cell) | (tag))
#define UNTAG(cell) ((CELL)(cell) & ~TAG_MASK)

/*** Tags ***/
#define FIXNUM_TYPE 0
#define BIGNUM_TYPE 1
#define CONS_TYPE 2
#define OBJECT_TYPE 3
#define RATIO_TYPE 4
#define FLOAT_TYPE 5
#define COMPLEX_TYPE 6
#define HEADER_TYPE 7 /* anything less than this is a tag */
#define GC_COLLECTED 7 /* See gc.c */

/*** Header types ***/

/* Canonical T object */
#define T_TYPE 7
CELL T;

#define ARRAY_TYPE 8

/* Canonical F object */
#define F_TYPE 9
#define F RETAG(0,OBJECT_TYPE)

#define HASHTABLE_TYPE 10
#define VECTOR_TYPE 11
#define STRING_TYPE 12
#define SBUF_TYPE 13
#define PORT_TYPE 14
#define DLL_TYPE 15
#define ALIEN_TYPE 16
#define WORD_TYPE 17
#define TUPLE_TYPE 18

#define TYPE_COUNT 19

INLINE bool headerp(CELL cell)
{
	return (cell != F
		&& TAG(cell) == OBJECT_TYPE
		&& cell < RETAG(TYPE_COUNT << TAG_BITS,OBJECT_TYPE));
}

INLINE CELL tag_header(CELL cell)
{
	return RETAG(cell << TAG_BITS,OBJECT_TYPE);
}

INLINE CELL untag_header(CELL cell)
{
	return cell >> TAG_BITS;
}

INLINE CELL tag_object(void* cell)
{
	return RETAG(cell,OBJECT_TYPE);
}

INLINE CELL object_type(CELL tagged)
{
	if(tagged == F)
		return F_TYPE;
	else
		return untag_header(get(UNTAG(tagged)));
}

INLINE void type_check(CELL type, CELL tagged)
{
	if(type < HEADER_TYPE)
	{
		if(TAG(tagged) == type)
			return;
	}
	else if(TAG(tagged) == OBJECT_TYPE
		&& object_type(tagged) == type)
	{
		return;
	}

	type_error(type,tagged);
}
/*
 * It is up to the caller to fill in the object's fields in a meaningful
 * fashion!
 */
INLINE void* allot_object(CELL type, CELL length)
{
	CELL* object = allot(length);
	*object = tag_header(type);
	return object;
}

CELL untagged_object_size(CELL pointer);
CELL object_size(CELL pointer);
void primitive_type(void);

INLINE CELL type_of(CELL tagged)
{
	CELL tag = TAG(tagged);
	if(tag == OBJECT_TYPE)
		return object_type(tagged);
	else
		return tag;
}

void primitive_slot(void);
void primitive_set_slot(void);
void primitive_integer_slot(void);
void primitive_set_integer_slot(void);