#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);