byterun/ints.c

   1 /***********************************************************************/
   2 /*                                                                     */
   3 /*                           Objective Caml                            */
   4 /*                                                                     */
   5 /*            Xavier Leroy, projet Cristal, 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$ */
  15
  16 #include <stdio.h>
  17 #include <string.h>
  18 #include "alloc.h"
  19 #include "custom.h"
  20 #include "fail.h"
  21 #include "intext.h"
  22 #include "memory.h"
  23 #include "misc.h"
  24 #include "mlvalues.h"
  25
  26 static char * parse_sign_and_base(char * p,
  27                                   /*out*/ int * base,
  28                                   /*out*/ int * sign)
  29 {
  30   *sign = 1;
  31   if (*p == '-') {
  32     *sign = -1;
  33     p++;
  34   }
  35   *base = 10;
  36   if (*p == '0') {
  37     switch (p[1]) {
  38     case 'x': case 'X':
  39       *base = 16; p += 2; break;
  40     case 'o': case 'O':
  41       *base = 8; p += 2; break;
  42     case 'b': case 'B':
  43       *base = 2; p += 2; break;
  44     }
  45   }
  46   return p;
  47 }
  48
  49 static int parse_digit(char c)
  50 {
  51   if (c >= '0' && c <= '9')
  52     return c - '0';
  53   else if (c >= 'A' && c <= 'F')
  54     return c - 'A' + 10;
  55   else if (c >= 'a' && c <= 'f')
  56     return c - 'a' + 10;
  57   else
  58     return -1;
  59 }
  60
  61 static intnat parse_intnat(value s, int nbits)
  62 {
  63   char * p;
  64   uintnat res, threshold;
  65   int sign, base, d;
  66
  67   p = parse_sign_and_base(String_val(s), &base, &sign);
  68   threshold = ((uintnat) -1) / base;
  69   d = parse_digit(*p);
  70   if (d < 0 || d >= base) caml_failwith("int_of_string");
  71   for (p++, res = d; /*nothing*/; p++) {
  72     char c = *p;
  73     if (c == '_') continue;
  74     d = parse_digit(c);
  75     if (d < 0 || d >= base) break;
  76     /* Detect overflow in multiplication base * res */
  77     if (res > threshold) caml_failwith("int_of_string");
  78     res = base * res + d;
  79     /* Detect overflow in addition (base * res) + d */
  80     if (res < (uintnat) d) caml_failwith("int_of_string");
  81   }
  82   if (p != String_val(s) + caml_string_length(s)){
  83     caml_failwith("int_of_string");
  84   }
  85   if (base == 10) {
  86     /* Signed representation expected, allow -2^(nbits-1) to 2^(nbits - 1) */
  87     if (res > (uintnat)1 << (nbits - 1))
  88       caml_failwith("int_of_string");
  89   } else {
  90     /* Unsigned representation expected, allow 0 to 2^nbits - 1
  91        and tolerate -(2^nbits - 1) to 0 */
  92     if (nbits < sizeof(uintnat) * 8 && res >= (uintnat)1 << nbits)
  93       caml_failwith("int_of_string");
  94   }
  95   return sign < 0 ? -((intnat) res) : (intnat) res;
  96 }
  97
  98 #ifdef NONSTANDARD_DIV_MOD
  99 intnat caml_safe_div(intnat p, intnat q)
 100 {
 101   uintnat ap = p >= 0 ? p : -p;
 102   uintnat aq = q >= 0 ? q : -q;
 103   uintnat ar = ap / aq;
 104   return (p ^ q) >= 0 ? ar : -ar;
 105 }
 106
 107 intnat caml_safe_mod(intnat p, intnat q)
 108 {
 109   uintnat ap = p >= 0 ? p : -p;
 110   uintnat aq = q >= 0 ? q : -q;
 111   uintnat ar = ap % aq;
 112   return p >= 0 ? ar : -ar;
 113 }
 114 #endif
 115
 116 /* Tagged integers */
 117
 118 CAMLprim value caml_int_compare(value v1, value v2)
 119 {
 120   int res = (v1 > v2) - (v1 < v2);
 121   return Val_int(res);
 122 }
 123
 124 CAMLprim value caml_int_of_string(value s)
 125 {
 126   return Val_long(parse_intnat(s, 8 * sizeof(value) - 1));
 127 }
 128
 129 #define FORMAT_BUFFER_SIZE 32
 130
 131 static char * parse_format(value fmt,
 132                            char * suffix,
 133                            char format_string[],
 134                            char default_format_buffer[],
 135                            char *conv)
 136 {
 137   int prec;
 138   char * p;
 139   char lastletter;
 140   mlsize_t len, len_suffix;
 141
 142   /* Copy Caml format fmt to format_string,
 143      adding the suffix before the last letter of the format */
 144   len = caml_string_length(fmt);
 145   len_suffix = strlen(suffix);
 146   if (len + len_suffix + 1 >= FORMAT_BUFFER_SIZE)
 147     caml_invalid_argument("format_int: format too long");
 148   memmove(format_string, String_val(fmt), len);
 149   p = format_string + len - 1;
 150   lastletter = *p;
 151   /* Compress two-letter formats, ignoring the [lnL] annotation */
 152   if (p[-1] == 'l' || p[-1] == 'n' || p[-1] == 'L') p--;
 153   memmove(p, suffix, len_suffix);  p += len_suffix;
 154   *p++ = lastletter;
 155   *p = 0;
 156   /* Determine space needed for result and allocate it dynamically if needed */
 157   prec = 22 + 5; /* 22 digits for 64-bit number in octal + 5 extra */
 158   for (p = String_val(fmt); *p != 0; p++) {
 159     if (*p >= '0' && *p <= '9') {
 160       prec = atoi(p) + 5;
 161       break;
 162     }
 163   }
 164   *conv = lastletter;
 165   if (prec < FORMAT_BUFFER_SIZE)
 166     return default_format_buffer;
 167   else
 168     return caml_stat_alloc(prec + 1);
 169 }
 170
 171 CAMLprim value caml_format_int(value fmt, value arg)
 172 {
 173   char format_string[FORMAT_BUFFER_SIZE];
 174   char default_format_buffer[FORMAT_BUFFER_SIZE];
 175   char * buffer;
 176   char conv;
 177   value res;
 178
 179   buffer = parse_format(fmt, ARCH_INTNAT_PRINTF_FORMAT,
 180                         format_string, default_format_buffer, &conv);
 181   switch (conv) {
 182   case 'u': case 'x': case 'X': case 'o':
 183     sprintf(buffer, format_string, Unsigned_long_val(arg));
 184     break;
 185   default:
 186     sprintf(buffer, format_string, Long_val(arg));
 187     break;
 188   }
 189   res = caml_copy_string(buffer);
 190   if (buffer != default_format_buffer) caml_stat_free(buffer);
 191   return res;
 192 }
 193
 194 /* 32-bit integers */
 195
 196 static int int32_cmp(value v1, value v2)
 197 {
 198   int32 i1 = Int32_val(v1);
 199   int32 i2 = Int32_val(v2);
 200   return (i1 > i2) - (i1 < i2);
 201 }
 202
 203 static intnat int32_hash(value v)
 204 {
 205   return Int32_val(v);
 206 }
 207
 208 static void int32_serialize(value v, uintnat * wsize_32,
 209                             uintnat * wsize_64)
 210 {
 211   caml_serialize_int_4(Int32_val(v));
 212   *wsize_32 = *wsize_64 = 4;
 213 }
 214
 215 static uintnat int32_deserialize(void * dst)
 216 {
 217   *((int32 *) dst) = caml_deserialize_sint_4();
 218   return 4;
 219 }
 220
 221 CAMLexport struct custom_operations caml_int32_ops = {
 222   "_i",
 223   custom_finalize_default,
 224   int32_cmp,
 225   int32_hash,
 226   int32_serialize,
 227   int32_deserialize
 228 };
 229
 230 CAMLexport value caml_copy_int32(int32 i)
 231 {
 232   value res = caml_alloc_custom(&caml_int32_ops, 4, 0, 1);
 233   Int32_val(res) = i;
 234   return res;
 235 }
 236
 237 CAMLprim value caml_int32_neg(value v)
 238 { return caml_copy_int32(- Int32_val(v)); }
 239
 240 CAMLprim value caml_int32_add(value v1, value v2)
 241 { return caml_copy_int32(Int32_val(v1) + Int32_val(v2)); }
 242
 243 CAMLprim value caml_int32_sub(value v1, value v2)
 244 { return caml_copy_int32(Int32_val(v1) - Int32_val(v2)); }
 245
 246 CAMLprim value caml_int32_mul(value v1, value v2)
 247 { return caml_copy_int32(Int32_val(v1) * Int32_val(v2)); }
 248
 249 CAMLprim value caml_int32_div(value v1, value v2)
 250 {
 251   int32 divisor = Int32_val(v2);
 252   if (divisor == 0) caml_raise_zero_divide();
 253 #ifdef NONSTANDARD_DIV_MOD
 254   return caml_copy_int32(caml_safe_div(Int32_val(v1), divisor));
 255 #else
 256   return caml_copy_int32(Int32_val(v1) / divisor);
 257 #endif
 258 }
 259
 260 CAMLprim value caml_int32_mod(value v1, value v2)
 261 {
 262   int32 divisor = Int32_val(v2);
 263   if (divisor == 0) caml_raise_zero_divide();
 264 #ifdef NONSTANDARD_DIV_MOD
 265   return caml_copy_int32(caml_safe_mod(Int32_val(v1), divisor));
 266 #else
 267   return caml_copy_int32(Int32_val(v1) % divisor);
 268 #endif
 269 }
 270
 271 CAMLprim value caml_int32_and(value v1, value v2)
 272 { return caml_copy_int32(Int32_val(v1) & Int32_val(v2)); }
 273
 274 CAMLprim value caml_int32_or(value v1, value v2)
 275 { return caml_copy_int32(Int32_val(v1) | Int32_val(v2)); }
 276
 277 CAMLprim value caml_int32_xor(value v1, value v2)
 278 { return caml_copy_int32(Int32_val(v1) ^ Int32_val(v2)); }
 279
 280 CAMLprim value caml_int32_shift_left(value v1, value v2)
 281 { return caml_copy_int32(Int32_val(v1) << Int_val(v2)); }
 282
 283 CAMLprim value caml_int32_shift_right(value v1, value v2)
 284 { return caml_copy_int32(Int32_val(v1) >> Int_val(v2)); }
 285
 286 CAMLprim value caml_int32_shift_right_unsigned(value v1, value v2)
 287 { return caml_copy_int32((uint32)Int32_val(v1) >> Int_val(v2)); }
 288
 289 CAMLprim value caml_int32_of_int(value v)
 290 { return caml_copy_int32(Long_val(v)); }
 291
 292 CAMLprim value caml_int32_to_int(value v)
 293 { return Val_long(Int32_val(v)); }
 294
 295 CAMLprim value caml_int32_of_float(value v)
 296 { return caml_copy_int32((int32)(Double_val(v))); }
 297
 298 CAMLprim value caml_int32_to_float(value v)
 299 { return caml_copy_double((double)(Int32_val(v))); }
 300
 301 CAMLprim value caml_int32_compare(value v1, value v2)
 302 {
 303   int32 i1 = Int32_val(v1);
 304   int32 i2 = Int32_val(v2);
 305   int res = (i1 > i2) - (i1 < i2);
 306   return Val_int(res);
 307 }
 308
 309 CAMLprim value caml_int32_format(value fmt, value arg)
 310 {
 311   char format_string[FORMAT_BUFFER_SIZE];
 312   char default_format_buffer[FORMAT_BUFFER_SIZE];
 313   char * buffer;
 314   char conv;
 315   value res;
 316
 317   buffer = parse_format(fmt, ARCH_INT32_PRINTF_FORMAT,
 318                         format_string, default_format_buffer, &conv);
 319   sprintf(buffer, format_string, Int32_val(arg));
 320   res = caml_copy_string(buffer);
 321   if (buffer != default_format_buffer) caml_stat_free(buffer);
 322   return res;
 323 }
 324
 325 CAMLprim value caml_int32_of_string(value s)
 326 {
 327   return caml_copy_int32(parse_intnat(s, 32));
 328 }
 329
 330 CAMLprim value caml_int32_bits_of_float(value vd)
 331 {
 332   union { float d; int32 i; } u;
 333   u.d = Double_val(vd);
 334   return caml_copy_int32(u.i);
 335 }
 336
 337 CAMLprim value caml_int32_float_of_bits(value vi)
 338 {
 339   union { float d; int32 i; } u;
 340   u.i = Int32_val(vi);
 341   return caml_copy_double(u.d);
 342 }
 343
 344 /* 64-bit integers */
 345
 346 #ifdef ARCH_INT64_TYPE
 347 #include "int64_native.h"
 348 #else
 349 #include "int64_emul.h"
 350 #endif
 351
 352 #ifdef ARCH_ALIGN_INT64
 353
 354 CAMLexport int64 caml_Int64_val(value v)
 355 {
 356   union { int32 i[2]; int64 j; } buffer;
 357   buffer.i[0] = ((int32 *) Data_custom_val(v))[0];
 358   buffer.i[1] = ((int32 *) Data_custom_val(v))[1];
 359   return buffer.j;
 360 }
 361
 362 #endif
 363
 364 static int int64_cmp(value v1, value v2)
 365 {
 366   int64 i1 = Int64_val(v1);
 367   int64 i2 = Int64_val(v2);
 368   return I64_compare(i1, i2);
 369 }
 370
 371 static intnat int64_hash(value v)
 372 {
 373   return I64_to_intnat(Int64_val(v));
 374 }
 375
 376 static void int64_serialize(value v, uintnat * wsize_32,
 377                             uintnat * wsize_64)
 378 {
 379   caml_serialize_int_8(Int64_val(v));
 380   *wsize_32 = *wsize_64 = 8;
 381 }
 382
 383 static uintnat int64_deserialize(void * dst)
 384 {
 385 #ifndef ARCH_ALIGN_INT64
 386   *((int64 *) dst) = caml_deserialize_sint_8();
 387 #else
 388   union { int32 i[2]; int64 j; } buffer;
 389   buffer.j = caml_deserialize_sint_8();
 390   ((int32 *) dst)[0] = buffer.i[0];
 391   ((int32 *) dst)[1] = buffer.i[1];
 392 #endif
 393   return 8;
 394 }
 395
 396 CAMLexport struct custom_operations caml_int64_ops = {
 397   "_j",
 398   custom_finalize_default,
 399   int64_cmp,
 400   int64_hash,
 401   int64_serialize,
 402   int64_deserialize
 403 };
 404
 405 CAMLexport value caml_copy_int64(int64 i)
 406 {
 407   value res = caml_alloc_custom(&caml_int64_ops, 8, 0, 1);
 408 #ifndef ARCH_ALIGN_INT64
 409   Int64_val(res) = i;
 410 #else
 411   union { int32 i[2]; int64 j; } buffer;
 412   buffer.j = i;
 413   ((int32 *) Data_custom_val(res))[0] = buffer.i[0];
 414   ((int32 *) Data_custom_val(res))[1] = buffer.i[1];
 415 #endif
 416   return res;
 417 }
 418
 419 CAMLprim value caml_int64_neg(value v)
 420 { return caml_copy_int64(I64_neg(Int64_val(v))); }
 421
 422 CAMLprim value caml_int64_add(value v1, value v2)
 423 { return caml_copy_int64(I64_add(Int64_val(v1), Int64_val(v2))); }
 424
 425 CAMLprim value caml_int64_sub(value v1, value v2)
 426 { return caml_copy_int64(I64_sub(Int64_val(v1), Int64_val(v2))); }
 427
 428 CAMLprim value caml_int64_mul(value v1, value v2)
 429 { return caml_copy_int64(I64_mul(Int64_val(v1), Int64_val(v2))); }
 430
 431 CAMLprim value caml_int64_div(value v1, value v2)
 432 {
 433   int64 divisor = Int64_val(v2);
 434   if (I64_is_zero(divisor)) caml_raise_zero_divide();
 435   return caml_copy_int64(I64_div(Int64_val(v1), divisor));
 436 }
 437
 438 CAMLprim value caml_int64_mod(value v1, value v2)
 439 {
 440   int64 divisor = Int64_val(v2);
 441   if (I64_is_zero(divisor)) caml_raise_zero_divide();
 442   return caml_copy_int64(I64_mod(Int64_val(v1), divisor));
 443 }
 444
 445 CAMLprim value caml_int64_and(value v1, value v2)
 446 { return caml_copy_int64(I64_and(Int64_val(v1), Int64_val(v2))); }
 447
 448 CAMLprim value caml_int64_or(value v1, value v2)
 449 { return caml_copy_int64(I64_or(Int64_val(v1), Int64_val(v2))); }
 450
 451 CAMLprim value caml_int64_xor(value v1, value v2)
 452 { return caml_copy_int64(I64_xor(Int64_val(v1), Int64_val(v2))); }
 453
 454 CAMLprim value caml_int64_shift_left(value v1, value v2)
 455 { return caml_copy_int64(I64_lsl(Int64_val(v1), Int_val(v2))); }
 456
 457 CAMLprim value caml_int64_shift_right(value v1, value v2)
 458 { return caml_copy_int64(I64_asr(Int64_val(v1), Int_val(v2))); }
 459
 460 CAMLprim value caml_int64_shift_right_unsigned(value v1, value v2)
 461 { return caml_copy_int64(I64_lsr(Int64_val(v1), Int_val(v2))); }
 462
 463 CAMLprim value caml_int64_of_int(value v)
 464 { return caml_copy_int64(I64_of_intnat(Long_val(v))); }
 465
 466 CAMLprim value caml_int64_to_int(value v)
 467 { return Val_long(I64_to_intnat(Int64_val(v))); }
 468
 469 CAMLprim value caml_int64_of_float(value v)
 470 { return caml_copy_int64(I64_of_double(Double_val(v))); }
 471
 472 CAMLprim value caml_int64_to_float(value v)
 473 {
 474   int64 i = Int64_val(v);
 475   return caml_copy_double(I64_to_double(i));
 476 }
 477
 478 CAMLprim value caml_int64_of_int32(value v)
 479 { return caml_copy_int64(I64_of_int32(Int32_val(v))); }
 480
 481 CAMLprim value caml_int64_to_int32(value v)
 482 { return caml_copy_int32(I64_to_int32(Int64_val(v))); }
 483
 484 CAMLprim value caml_int64_of_nativeint(value v)
 485 { return caml_copy_int64(I64_of_intnat(Nativeint_val(v))); }
 486
 487 CAMLprim value caml_int64_to_nativeint(value v)
 488 { return caml_copy_nativeint(I64_to_intnat(Int64_val(v))); }
 489
 490 CAMLprim value caml_int64_compare(value v1, value v2)
 491 {
 492   int64 i1 = Int64_val(v1);
 493   int64 i2 = Int64_val(v2);
 494   return Val_int(I64_compare(i1, i2));
 495 }
 496
 497 #ifdef ARCH_INT64_PRINTF_FORMAT
 498 #define I64_format(buf,fmt,x) sprintf(buf,fmt,x)
 499 #else
 500 #include "int64_format.h"
 501 #define ARCH_INT64_PRINTF_FORMAT ""
 502 #endif
 503
 504 CAMLprim value caml_int64_format(value fmt, value arg)
 505 {
 506   char format_string[FORMAT_BUFFER_SIZE];
 507   char default_format_buffer[FORMAT_BUFFER_SIZE];
 508   char * buffer;
 509   char conv;
 510   value res;
 511
 512   buffer = parse_format(fmt, ARCH_INT64_PRINTF_FORMAT,
 513                         format_string, default_format_buffer, &conv);
 514   I64_format(buffer, format_string, Int64_val(arg));
 515   res = caml_copy_string(buffer);
 516   if (buffer != default_format_buffer) caml_stat_free(buffer);
 517   return res;
 518 }
 519
 520 CAMLprim value caml_int64_of_string(value s)
 521 {
 522   char * p;
 523   uint64 max_uint64 = I64_literal(0xFFFFFFFF, 0xFFFFFFFF);
 524   uint64 max_int64  = I64_literal(0x80000000, 0x00000000);
 525   uint64 res, threshold;
 526   int sign, base, d;
 527
 528   p = parse_sign_and_base(String_val(s), &base, &sign);
 529   I64_udivmod(max_uint64, I64_of_int32(base), &threshold, &res);
 530   d = parse_digit(*p);
 531   if (d < 0 || d >= base) caml_failwith("int_of_string");
 532   res = I64_of_int32(d);
 533   for (p++; /*nothing*/; p++) {
 534     char c = *p;
 535     if (c == '_') continue;
 536     d = parse_digit(c);
 537     if (d < 0 || d >= base) break;
 538     /* Detect overflow in multiplication base * res */
 539     if (I64_ult(threshold, res)) caml_failwith("int_of_string");
 540     res = I64_add(I64_mul(I64_of_int32(base), res), I64_of_int32(d));
 541     /* Detect overflow in addition (base * res) + d */
 542     if (I64_ult(res, I64_of_int32(d))) caml_failwith("int_of_string");
 543   }
 544   if (p != String_val(s) + caml_string_length(s)){
 545     caml_failwith("int_of_string");
 546   }
 547   if (base == 10 && I64_ult(max_int64, res)) caml_failwith("int_of_string");
 548   if (sign < 0) res = I64_neg(res);
 549   return caml_copy_int64(res);
 550 }
 551
 552 CAMLprim value caml_int64_bits_of_float(value vd)
 553 {
 554   union { double d; int64 i; int32 h[2]; } u;
 555   u.d = Double_val(vd);
 556 #if defined(__arm__) && !defined(__ARM_EABI__)
 557   { int32 t = u.h[0]; u.h[0] = u.h[1]; u.h[1] = t; }
 558 #endif
 559   return caml_copy_int64(u.i);
 560 }
 561
 562 CAMLprim value caml_int64_float_of_bits(value vi)
 563 {
 564   union { double d; int64 i; int32 h[2]; } u;
 565   u.i = Int64_val(vi);
 566 #if defined(__arm__) && !defined(__ARM_EABI__)
 567   { int32 t = u.h[0]; u.h[0] = u.h[1]; u.h[1] = t; }
 568 #endif
 569   return caml_copy_double(u.d);
 570 }
 571
 572 /* Native integers */
 573
 574 static int nativeint_cmp(value v1, value v2)
 575 {
 576   intnat i1 = Nativeint_val(v1);
 577   intnat i2 = Nativeint_val(v2);
 578   return (i1 > i2) - (i1 < i2);
 579 }
 580
 581 static intnat nativeint_hash(value v)
 582 {
 583   return Nativeint_val(v);
 584 }
 585
 586 static void nativeint_serialize(value v, uintnat * wsize_32,
 587                                 uintnat * wsize_64)
 588 {
 589   intnat l = Nativeint_val(v);
 590 #ifdef ARCH_SIXTYFOUR
 591   if (l <= 0x7FFFFFFFL && l >= -0x80000000L) {
 592     caml_serialize_int_1(1);
 593     caml_serialize_int_4((int32) l);
 594   } else {
 595     caml_serialize_int_1(2);
 596     caml_serialize_int_8(l);
 597   }
 598 #else
 599   caml_serialize_int_1(1);
 600   caml_serialize_int_4(l);
 601 #endif
 602   *wsize_32 = 4;
 603   *wsize_64 = 8;
 604 }
 605
 606 static uintnat nativeint_deserialize(void * dst)
 607 {
 608   switch (caml_deserialize_uint_1()) {
 609   case 1:
 610     *((intnat *) dst) = caml_deserialize_sint_4();
 611     break;
 612   case 2:
 613 #ifdef ARCH_SIXTYFOUR
 614     *((intnat *) dst) = caml_deserialize_sint_8();
 615 #else
 616     caml_deserialize_error("input_value: native integer value too large");
 617 #endif
 618     break;
 619   default:
 620     caml_deserialize_error("input_value: ill-formed native integer");
 621   }
 622   return sizeof(long);
 623 }
 624
 625 CAMLexport struct custom_operations caml_nativeint_ops = {
 626   "_n",
 627   custom_finalize_default,
 628   nativeint_cmp,
 629   nativeint_hash,
 630   nativeint_serialize,
 631   nativeint_deserialize
 632 };
 633
 634 CAMLexport value caml_copy_nativeint(intnat i)
 635 {
 636   value res = caml_alloc_custom(&caml_nativeint_ops, sizeof(intnat), 0, 1);
 637   Nativeint_val(res) = i;
 638   return res;
 639 }
 640
 641 CAMLprim value caml_nativeint_neg(value v)
 642 { return caml_copy_nativeint(- Nativeint_val(v)); }
 643
 644 CAMLprim value caml_nativeint_add(value v1, value v2)
 645 { return caml_copy_nativeint(Nativeint_val(v1) + Nativeint_val(v2)); }
 646
 647 CAMLprim value caml_nativeint_sub(value v1, value v2)
 648 { return caml_copy_nativeint(Nativeint_val(v1) - Nativeint_val(v2)); }
 649
 650 CAMLprim value caml_nativeint_mul(value v1, value v2)
 651 { return caml_copy_nativeint(Nativeint_val(v1) * Nativeint_val(v2)); }
 652
 653 CAMLprim value caml_nativeint_div(value v1, value v2)
 654 {
 655   intnat divisor = Nativeint_val(v2);
 656   if (divisor == 0) caml_raise_zero_divide();
 657 #ifdef NONSTANDARD_DIV_MOD
 658   return caml_copy_nativeint(caml_safe_div(Nativeint_val(v1), divisor));
 659 #else
 660   return caml_copy_nativeint(Nativeint_val(v1) / divisor);
 661 #endif
 662 }
 663
 664 CAMLprim value caml_nativeint_mod(value v1, value v2)
 665 {
 666   intnat divisor = Nativeint_val(v2);
 667   if (divisor == 0) caml_raise_zero_divide();
 668 #ifdef NONSTANDARD_DIV_MOD
 669   return caml_copy_nativeint(caml_safe_mod(Nativeint_val(v1), divisor));
 670 #else
 671   return caml_copy_nativeint(Nativeint_val(v1) % divisor);
 672 #endif
 673 }
 674
 675 CAMLprim value caml_nativeint_and(value v1, value v2)
 676 { return caml_copy_nativeint(Nativeint_val(v1) & Nativeint_val(v2)); }
 677
 678 CAMLprim value caml_nativeint_or(value v1, value v2)
 679 { return caml_copy_nativeint(Nativeint_val(v1) | Nativeint_val(v2)); }
 680
 681 CAMLprim value caml_nativeint_xor(value v1, value v2)
 682 { return caml_copy_nativeint(Nativeint_val(v1) ^ Nativeint_val(v2)); }
 683
 684 CAMLprim value caml_nativeint_shift_left(value v1, value v2)
 685 { return caml_copy_nativeint(Nativeint_val(v1) << Int_val(v2)); }
 686
 687 CAMLprim value caml_nativeint_shift_right(value v1, value v2)
 688 { return caml_copy_nativeint(Nativeint_val(v1) >> Int_val(v2)); }
 689
 690 CAMLprim value caml_nativeint_shift_right_unsigned(value v1, value v2)
 691 { return caml_copy_nativeint((uintnat)Nativeint_val(v1) >> Int_val(v2)); }
 692
 693 CAMLprim value caml_nativeint_of_int(value v)
 694 { return caml_copy_nativeint(Long_val(v)); }
 695
 696 CAMLprim value caml_nativeint_to_int(value v)
 697 { return Val_long(Nativeint_val(v)); }
 698
 699 CAMLprim value caml_nativeint_of_float(value v)
 700 { return caml_copy_nativeint((intnat)(Double_val(v))); }
 701
 702 CAMLprim value caml_nativeint_to_float(value v)
 703 { return caml_copy_double((double)(Nativeint_val(v))); }
 704
 705 CAMLprim value caml_nativeint_of_int32(value v)
 706 { return caml_copy_nativeint(Int32_val(v)); }
 707
 708 CAMLprim value caml_nativeint_to_int32(value v)
 709 { return caml_copy_int32(Nativeint_val(v)); }
 710
 711 CAMLprim value caml_nativeint_compare(value v1, value v2)
 712 {
 713   intnat i1 = Nativeint_val(v1);
 714   intnat i2 = Nativeint_val(v2);
 715   int res = (i1 > i2) - (i1 < i2);
 716   return Val_int(res);
 717 }
 718
 719 CAMLprim value caml_nativeint_format(value fmt, value arg)
 720 {
 721   char format_string[FORMAT_BUFFER_SIZE];
 722   char default_format_buffer[FORMAT_BUFFER_SIZE];
 723   char * buffer;
 724   char conv;
 725   value res;
 726
 727   buffer = parse_format(fmt, ARCH_INTNAT_PRINTF_FORMAT,
 728                         format_string, default_format_buffer, &conv);
 729   sprintf(buffer, format_string, Nativeint_val(arg));
 730   res = caml_copy_string(buffer);
 731   if (buffer != default_format_buffer) caml_stat_free(buffer);
 732   return res;
 733 }
 734
 735 CAMLprim value caml_nativeint_of_string(value s)
 736 {
 737   return caml_copy_nativeint(parse_intnat(s, 8 * sizeof(value)));
 738 }