84 lines
1.6 KiB
C
84 lines
1.6 KiB
C
#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 HEADER_TYPE 5
|
|
#define GC_COLLECTED 6 /* See gc.c */
|
|
|
|
/*** Header types ***/
|
|
|
|
/* Canonical F object */
|
|
#define F_TYPE 6
|
|
CELL F;
|
|
|
|
/* Canonical T object */
|
|
#define T_TYPE 7
|
|
CELL T;
|
|
|
|
/* Empty stack marker */
|
|
#define EMPTY_TYPE 8
|
|
CELL empty;
|
|
|
|
#define ARRAY_TYPE 9
|
|
#define VECTOR_TYPE 10
|
|
#define STRING_TYPE 11
|
|
#define SBUF_TYPE 12
|
|
#define HANDLE_TYPE 13
|
|
#define BIGNUM_TYPE 14
|
|
#define FLOAT_TYPE 15
|
|
|
|
bool typep(CELL type, CELL tagged);
|
|
CELL type_of(CELL tagged);
|
|
void type_check(CELL type, CELL tagged);
|
|
|
|
INLINE void check_non_empty(CELL cell)
|
|
{
|
|
if(cell == empty)
|
|
general_error(ERROR_UNDERFLOW,F);
|
|
}
|
|
|
|
INLINE CELL tag_boolean(CELL untagged)
|
|
{
|
|
return (untagged == false ? F : T);
|
|
}
|
|
|
|
INLINE bool untag_boolean(CELL tagged)
|
|
{
|
|
check_non_empty(tagged);
|
|
return (tagged == F ? false : true);
|
|
}
|
|
|
|
INLINE CELL tag_header(CELL cell)
|
|
{
|
|
return RETAG(cell << TAG_BITS,HEADER_TYPE);
|
|
}
|
|
|
|
INLINE CELL untag_header(CELL cell)
|
|
{
|
|
if(TAG(cell) != HEADER_TYPE)
|
|
critical_error("header type check",cell);
|
|
return cell >> TAG_BITS;
|
|
}
|
|
|
|
INLINE CELL tag_object(void* cell)
|
|
{
|
|
return RETAG(cell,OBJECT_TYPE);
|
|
}
|
|
|
|
INLINE CELL object_type(CELL tagged)
|
|
{
|
|
return untag_header(get(UNTAG(tagged)));
|
|
}
|
|
|
|
void* allot_object(CELL type, CELL length);
|
|
CELL untagged_object_size(CELL pointer);
|
|
CELL object_size(CELL pointer);
|