l4/pkg/ocaml/ocaml/contrib/byterun/mlvalues.h

   1 /***********************************************************************/
   2 /*                                                                     */
   3 /*                           Objective Caml                            */
   4 /*                                                                     */
   5 /*         Xavier Leroy and Damien Doligez, INRIA Rocquencourt         */
   6 /*                                                                     */
   7 /*  Copyright 1996 Institut National de Recherche en Informatique et   */
   8 /*  en Automatique.  All rights reserved.  This file is distributed    */
   9 /*  under the terms of the GNU Library General Public License, with    */
  10 /*  the special exception on linking described in file ../LICENSE.     */
  11 /*                                                                     */
  12 /***********************************************************************/
  13
  14 /* $Id: mlvalues.h 8970 2008-08-01 14:10:36Z xleroy $ */
  15
  16 #ifndef CAML_MLVALUES_H
  17 #define CAML_MLVALUES_H
  18
  19 #ifndef CAML_NAME_SPACE
  20 #include "compatibility.h"
  21 #endif
  22 #include "config.h"
  23 #include "misc.h"
  24
  25 /* Definitions
  26
  27   word: Four bytes on 32 and 16 bit architectures,
  28         eight bytes on 64 bit architectures.
  29   long: A C integer having the same number of bytes as a word.
  30   val: The ML representation of something.  A long or a block or a pointer
  31        outside the heap.  If it is a block, it is the (encoded) address
  32        of an object.  If it is a long, it is encoded as well.
  33   block: Something allocated.  It always has a header and some
  34           fields or some number of bytes (a multiple of the word size).
  35   field: A word-sized val which is part of a block.
  36   bp: Pointer to the first byte of a block.  (a char *)
  37   op: Pointer to the first field of a block.  (a value *)
  38   hp: Pointer to the header of a block.  (a char *)
  39   int32: Four bytes on all architectures.
  40   int64: Eight bytes on all architectures.
  41
  42   Remark: A block size is always a multiple of the word size, and at least
  43           one word plus the header.
  44
  45   bosize: Size (in bytes) of the "bytes" part.
  46   wosize: Size (in words) of the "fields" part.
  47   bhsize: Size (in bytes) of the block with its header.
  48   whsize: Size (in words) of the block with its header.
  49
  50   hd: A header.
  51   tag: The value of the tag field of the header.
  52   color: The value of the color field of the header.
  53          This is for use only by the GC.
  54 */
  55
  56 typedef intnat value;
  57 typedef uintnat header_t;
  58 typedef uintnat mlsize_t;
  59 typedef unsigned int tag_t;             /* Actually, an unsigned char */
  60 typedef uintnat color_t;
  61 typedef uintnat mark_t;
  62
  63 /* Longs vs blocks. */
  64 #define Is_long(x)   (((x) & 1) != 0)
  65 #define Is_block(x)  (((x) & 1) == 0)
  66
  67 /* Conversion macro names are always of the form  "to_from". */
  68 /* Example: Val_long as in "Val from long" or "Val of long". */
  69 #define Val_long(x)     (((intnat)(x) << 1) + 1)
  70 #define Long_val(x)     ((x) >> 1)
  71 #define Max_long (((intnat)1 << (8 * sizeof(value) - 2)) - 1)
  72 #define Min_long (-((intnat)1 << (8 * sizeof(value) - 2)))
  73 #define Val_int(x) Val_long(x)
  74 #define Int_val(x) ((int) Long_val(x))
  75 #define Unsigned_long_val(x) ((uintnat)(x) >> 1)
  76 #define Unsigned_int_val(x)  ((int) Unsigned_long_val(x))
  77
  78 /* Structure of the header:
  79
  80 For 16-bit and 32-bit architectures:
  81      +--------+-------+-----+
  82      | wosize | color | tag |
  83      +--------+-------+-----+
  84 bits  31    10 9     8 7   0
  85
  86 For 64-bit architectures:
  87
  88      +--------+-------+-----+
  89      | wosize | color | tag |
  90      +--------+-------+-----+
  91 bits  63    10 9     8 7   0
  92
  93 */
  94
  95 #define Tag_hd(hd) ((tag_t) ((hd) & 0xFF))
  96 #define Wosize_hd(hd) ((mlsize_t) ((hd) >> 10))
  97
  98 #define Hd_val(val) (((header_t *) (val)) [-1])        /* Also an l-value. */
  99 #define Hd_op(op) (Hd_val (op))                        /* Also an l-value. */
 100 #define Hd_bp(bp) (Hd_val (bp))                        /* Also an l-value. */
 101 #define Hd_hp(hp) (* ((header_t *) (hp)))              /* Also an l-value. */
 102 #define Hp_val(val) ((char *) (((header_t *) (val)) - 1))
 103 #define Hp_op(op) (Hp_val (op))
 104 #define Hp_bp(bp) (Hp_val (bp))
 105 #define Val_op(op) ((value) (op))
 106 #define Val_hp(hp) ((value) (((header_t *) (hp)) + 1))
 107 #define Op_hp(hp) ((value *) Val_hp (hp))
 108 #define Bp_hp(hp) ((char *) Val_hp (hp))
 109
 110 #define Num_tags (1 << 8)
 111 #ifdef ARCH_SIXTYFOUR
 112 #define Max_wosize (((intnat)1 << 54) - 1)
 113 #else
 114 #define Max_wosize ((1 << 22) - 1)
 115 #endif
 116
 117 #define Wosize_val(val) (Wosize_hd (Hd_val (val)))
 118 #define Wosize_op(op) (Wosize_val (op))
 119 #define Wosize_bp(bp) (Wosize_val (bp))
 120 #define Wosize_hp(hp) (Wosize_hd (Hd_hp (hp)))
 121 #define Whsize_wosize(sz) ((sz) + 1)
 122 #define Wosize_whsize(sz) ((sz) - 1)
 123 #define Wosize_bhsize(sz) ((sz) / sizeof (value) - 1)
 124 #define Bsize_wsize(sz) ((sz) * sizeof (value))
 125 #define Wsize_bsize(sz) ((sz) / sizeof (value))
 126 #define Bhsize_wosize(sz) (Bsize_wsize (Whsize_wosize (sz)))
 127 #define Bhsize_bosize(sz) ((sz) + sizeof (header_t))
 128 #define Bosize_val(val) (Bsize_wsize (Wosize_val (val)))
 129 #define Bosize_op(op) (Bosize_val (Val_op (op)))
 130 #define Bosize_bp(bp) (Bosize_val (Val_bp (bp)))
 131 #define Bosize_hd(hd) (Bsize_wsize (Wosize_hd (hd)))
 132 #define Whsize_hp(hp) (Whsize_wosize (Wosize_hp (hp)))
 133 #define Whsize_val(val) (Whsize_hp (Hp_val (val)))
 134 #define Whsize_bp(bp) (Whsize_val (Val_bp (bp)))
 135 #define Whsize_hd(hd) (Whsize_wosize (Wosize_hd (hd)))
 136 #define Bhsize_hp(hp) (Bsize_wsize (Whsize_hp (hp)))
 137 #define Bhsize_hd(hd) (Bsize_wsize (Whsize_hd (hd)))
 138
 139 #ifdef ARCH_BIG_ENDIAN
 140 #define Tag_val(val) (((unsigned char *) (val)) [-1])
 141                                                  /* Also an l-value. */
 142 #define Tag_hp(hp) (((unsigned char *) (hp)) [sizeof(value)-1])
 143                                                  /* Also an l-value. */
 144 #else
 145 #define Tag_val(val) (((unsigned char *) (val)) [-sizeof(value)])
 146                                                  /* Also an l-value. */
 147 #define Tag_hp(hp) (((unsigned char *) (hp)) [0])
 148                                                  /* Also an l-value. */
 149 #endif
 150
 151 /* The lowest tag for blocks containing no value. */
 152 #define No_scan_tag 251
 153
 154
 155 /* 1- If tag < No_scan_tag : a tuple of fields.  */
 156
 157 /* Pointer to the first field. */
 158 #define Op_val(x) ((value *) (x))
 159 /* Fields are numbered from 0. */
 160 #define Field(x, i) (((value *)(x)) [i])           /* Also an l-value. */
 161
 162 typedef int32 opcode_t;
 163 typedef opcode_t * code_t;
 164
 165 /* NOTE: [Forward_tag] and [Infix_tag] must be just under
 166    [No_scan_tag], with [Infix_tag] the lower one.
 167    See [caml_oldify_one] in minor_gc.c for more details.
 168
 169    NOTE: Update stdlib/obj.ml whenever you change the tags.
 170  */
 171
 172 /* Forward_tag: forwarding pointer that the GC may silently shortcut.
 173    See stdlib/lazy.ml. */
 174 #define Forward_tag 250
 175 #define Forward_val(v) Field(v, 0)
 176
 177 /* If tag == Infix_tag : an infix header inside a closure */
 178 /* Infix_tag must be odd so that the infix header is scanned as an integer */
 179 /* Infix_tag must be 1 modulo 4 and infix headers can only occur in blocks
 180    with tag Closure_tag (see compact.c). */
 181
 182 #define Infix_tag 249
 183 #define Infix_offset_hd(hd) (Bosize_hd(hd))
 184 #define Infix_offset_val(v) Infix_offset_hd(Hd_val(v))
 185
 186 /* Another special case: objects */
 187 #define Object_tag 248
 188 #define Class_val(val) Field((val), 0)
 189 #define Oid_val(val) Long_val(Field((val), 1))
 190 CAMLextern value caml_get_public_method (value obj, value tag);
 191 /* Called as:
 192    caml_callback(caml_get_public_method(obj, caml_hash_variant(name)), obj) */
 193 /* caml_get_public_method returns 0 if tag not in the table.
 194    Note however that tags being hashed, same tag does not necessarily mean
 195    same method name. */
 196
 197 /* Special case of tuples of fields: closures */
 198 #define Closure_tag 247
 199 #define Code_val(val) (((code_t *) (val)) [0])     /* Also an l-value. */
 200
 201 /* This tag is used (with Forward_tag) to implement lazy values.
 202    See major_gc.c and stdlib/lazy.ml. */
 203 #define Lazy_tag 246
 204
 205 /* Another special case: variants */
 206 CAMLextern value caml_hash_variant(char const * tag);
 207
 208 /* 2- If tag >= No_scan_tag : a sequence of bytes. */
 209
 210 /* Pointer to the first byte */
 211 #define Bp_val(v) ((char *) (v))
 212 #define Val_bp(p) ((value) (p))
 213 /* Bytes are numbered from 0. */
 214 #define Byte(x, i) (((char *) (x)) [i])            /* Also an l-value. */
 215 #define Byte_u(x, i) (((unsigned char *) (x)) [i]) /* Also an l-value. */
 216
 217 /* Abstract things.  Their contents is not traced by the GC; therefore they
 218    must not contain any [value].
 219 */
 220 #define Abstract_tag 251
 221
 222 /* Strings. */
 223 #define String_tag 252
 224 #define String_val(x) ((char *) Bp_val(x))
 225 CAMLextern mlsize_t caml_string_length (value);   /* size in bytes */
 226
 227 /* Floating-point numbers. */
 228 #define Double_tag 253
 229 #define Double_wosize ((sizeof(double) / sizeof(value)))
 230 #ifndef ARCH_ALIGN_DOUBLE
 231 #define Double_val(v) (* (double *)(v))
 232 #define Store_double_val(v,d) (* (double *)(v) = (d))
 233 #else
 234 CAMLextern double caml_Double_val (value);
 235 CAMLextern void caml_Store_double_val (value,double);
 236 #define Double_val(v) caml_Double_val(v)
 237 #define Store_double_val(v,d) caml_Store_double_val(v,d)
 238 #endif
 239
 240 /* Arrays of floating-point numbers. */
 241 #define Double_array_tag 254
 242 #define Double_field(v,i) Double_val((value)((double *)(v) + (i)))
 243 #define Store_double_field(v,i,d) do{ \
 244   mlsize_t caml__temp_i = (i); \
 245   double caml__temp_d = (d); \
 246   Store_double_val((value)((double *) (v) + caml__temp_i), caml__temp_d); \
 247 }while(0)
 248
 249 /* Custom blocks.  They contain a pointer to a "method suite"
 250    of functions (for finalization, comparison, hashing, etc)
 251    followed by raw data.  The contents of custom blocks is not traced by
 252    the GC; therefore, they must not contain any [value].
 253    See [custom.h] for operations on method suites. */
 254 #define Custom_tag 255
 255 #define Data_custom_val(v) ((void *) &Field((v), 1))
 256 struct custom_operations;       /* defined in [custom.h] */
 257
 258 /* Int32.t, Int64.t and Nativeint.t are represented as custom blocks. */
 259
 260 #define Int32_val(v) (*((int32 *) Data_custom_val(v)))
 261 #define Nativeint_val(v) (*((intnat *) Data_custom_val(v)))
 262 #ifndef ARCH_ALIGN_INT64
 263 #define Int64_val(v) (*((int64 *) Data_custom_val(v)))
 264 #else
 265 CAMLextern int64 caml_Int64_val(value v);
 266 #define Int64_val(v) caml_Int64_val(v)
 267 #endif
 268
 269 /* 3- Atoms are 0-tuples.  They are statically allocated once and for all. */
 270
 271 CAMLextern header_t caml_atom_table[];
 272 #define Atom(tag) (Val_hp (&(caml_atom_table [(tag)])))
 273
 274 /* Booleans are integers 0 or 1 */
 275
 276 #define Val_bool(x) Val_int((x) != 0)
 277 #define Bool_val(x) Int_val(x)
 278 #define Val_false Val_int(0)
 279 #define Val_true Val_int(1)
 280 #define Val_not(x) (Val_false + Val_true - (x))
 281
 282 /* The unit value is 0 (tagged) */
 283
 284 #define Val_unit Val_int(0)
 285
 286 /* List constructors */
 287 #define Val_emptylist Val_int(0)
 288 #define Tag_cons 0
 289
 290 /* The table of global identifiers */
 291
 292 extern value caml_global_data;
 293
 294
 295 #endif /* CAML_MLVALUES_H */