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