native/types.h

   1 #define TAG_MASK 7
   2 #define TAG_BITS 3
   3 #define TAG(cell) ((CELL)(cell) & TAG_MASK)
   4 #define RETAG(cell,tag) ((CELL)(cell) | (tag))
   5 #define UNTAG(cell) ((CELL)(cell) & ~TAG_MASK)
   6
   7 /*** Tags ***/
   8 #define FIXNUM_TYPE 0
   9 #define WORD_TYPE 1
  10 #define CONS_TYPE 2
  11 #define OBJECT_TYPE 3
  12 #define HEADER_TYPE 4
  13 #define GC_COLLECTED 5 /* See gc.c */
  14
  15 /*** Header types ***/
  16
  17 /* Canonical F object */
  18 #define F_TYPE 6
  19 CELL F;
  20
  21 /* Canonical T object */
  22 #define T_TYPE 7
  23 CELL T;
  24
  25 /* Empty stack marker */
  26 #define EMPTY_TYPE 8
  27 CELL empty;
  28
  29 #define ARRAY_TYPE 9
  30 #define VECTOR_TYPE 10
  31 #define STRING_TYPE 11
  32 #define SBUF_TYPE 12
  33 #define HANDLE_TYPE 13
  34 #define BIGNUM_TYPE 14
  35
  36 bool typep(CELL type, CELL tagged);
  37 CELL type_of(CELL tagged);
  38 void type_check(CELL type, CELL tagged);
  39
  40 INLINE void check_non_empty(CELL cell)
  41 {
  42         if(cell == empty)
  43                 general_error(ERROR_UNDERFLOW,F);
  44 }
  45
  46 INLINE CELL tag_boolean(CELL untagged)
  47 {
  48         return (untagged == false ? F : T);
  49 }
  50
  51 INLINE bool untag_boolean(CELL tagged)
  52 {
  53         check_non_empty(tagged);
  54         return (tagged == F ? false : true);
  55 }
  56
  57 INLINE CELL tag_header(CELL cell)
  58 {
  59         return RETAG(cell << TAG_BITS,HEADER_TYPE);
  60 }
  61
  62 INLINE CELL untag_header(CELL cell)
  63 {
  64         if(TAG(cell) != HEADER_TYPE)
  65                 critical_error("header type check",cell);
  66         return cell >> TAG_BITS;
  67 }
  68
  69 INLINE CELL tag_object(void* cell)
  70 {
  71         return RETAG(cell,OBJECT_TYPE);
  72 }
  73
  74 INLINE CELL object_type(CELL tagged)
  75 {
  76         return untag_header(get(UNTAG(tagged)));
  77 }
  78
  79 CELL allot_object(CELL type, CELL length);
  80 CELL untagged_object_size(CELL pointer);
  81 CELL object_size(CELL pointer);