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 WORD_TYPE 1
#define CONS_TYPE 2
#define OBJECT_TYPE 3
#define RATIO_TYPE 4
#define COMPLEX_TYPE 5
#define HEADER_TYPE 6
#define GC_COLLECTED 7 /* See gc.c */

/*** Header types ***/

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

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

#define ARRAY_TYPE 8
#define BIGNUM_TYPE 9
#define FLOAT_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 TYPE_COUNT 17

/* Pseudo-types. For error reporting only. */
#define INTEGER_TYPE 100 /* F_FIXNUM or BIGNUM */
#define RATIONAL_TYPE 101 /* INTEGER or F_RATIO */
#define REAL_TYPE 102 /* RATIONAL or F_FLOAT */
#define NUMBER_TYPE 103 /* F_COMPLEX or REAL */
#define TEXT_TYPE 104 /* F_FIXNUM or F_STRING */

DLLEXPORT CELL type_of(CELL tagged);
bool typep(CELL type, CELL tagged);

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

INLINE CELL untag_header(CELL cell)
{
	CELL type = cell >> TAG_BITS;
#ifdef HEADER_DEBUG
	if(TAG(cell) != HEADER_TYPE)
		critical_error("header type check",cell);
	if(type <= HEADER_TYPE && type != WORD_TYPE)
		critical_error("header invariant check",cell);
#endif
	return type;
}

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

INLINE CELL object_type(CELL tagged)
{
	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(tagged == F)
	{
		if(type == F_TYPE)
			return;
	}
	else if(TAG(tagged) == OBJECT_TYPE
		&& object_type(tagged) == type)
	{
		return;
	}

	type_error(type,tagged);
}

void* allot_object(CELL type, CELL length);
CELL untagged_object_size(CELL pointer);
CELL object_size(CELL pointer);
void primitive_type(void);
void primitive_size(void);