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