l4/pkg/ocaml/contrib/byterun/intern.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: intern.c 8768 2008-01-11 16:13:18Z doligez $ */
  15
  16 /* Structured input, compact format */
  17
  18 /* The interface of this file is "intext.h" */
  19
  20 #include <string.h>
  21 #include "alloc.h"
  22 #include "custom.h"
  23 #include "fail.h"
  24 #include "gc.h"
  25 #include "intext.h"
  26 #include "io.h"
  27 #include "memory.h"
  28 #include "mlvalues.h"
  29 #include "misc.h"
  30 #include "reverse.h"
  31
  32 static unsigned char * intern_src;
  33 /* Reading pointer in block holding input data. */
  34
  35 static unsigned char * intern_input;
  36 /* Pointer to beginning of block holding input data.
  37    Meaningful only if intern_input_malloced = 1. */
  38
  39 static int intern_input_malloced;
  40 /* 1 if intern_input was allocated by caml_stat_alloc()
  41    and needs caml_stat_free() on error, 0 otherwise. */
  42
  43 static header_t * intern_dest;
  44 /* Writing pointer in destination block */
  45
  46 static char * intern_extra_block;
  47 /* If non-NULL, point to new heap chunk allocated with caml_alloc_for_heap. */
  48
  49 static asize_t obj_counter;
  50 /* Count how many objects seen so far */
  51
  52 static value * intern_obj_table;
  53 /* The pointers to objects already seen */
  54
  55 static unsigned int intern_color;
  56 /* Color to assign to newly created headers */
  57
  58 static header_t intern_header;
  59 /* Original header of the destination block.
  60    Meaningful only if intern_extra_block is NULL. */
  61
  62 static value intern_block;
  63 /* Point to the heap block allocated as destination block.
  64    Meaningful only if intern_extra_block is NULL. */
  65
  66 #define Sign_extend_shift ((sizeof(intnat) - 1) * 8)
  67 #define Sign_extend(x) (((intnat)(x) << Sign_extend_shift) >> Sign_extend_shift)
  68
  69 #define read8u() (*intern_src++)
  70 #define read8s() Sign_extend(*intern_src++)
  71 #define read16u() \
  72   (intern_src += 2, \
  73    (intern_src[-2] << 8) + intern_src[-1])
  74 #define read16s() \
  75   (intern_src += 2, \
  76    (Sign_extend(intern_src[-2]) << 8) + intern_src[-1])
  77 #define read32u() \
  78   (intern_src += 4, \
  79    ((uintnat)(intern_src[-4]) << 24) + (intern_src[-3] << 16) + \
  80    (intern_src[-2] << 8) + intern_src[-1])
  81 #define read32s() \
  82   (intern_src += 4, \
  83    (Sign_extend(intern_src[-4]) << 24) + (intern_src[-3] << 16) + \
  84    (intern_src[-2] << 8) + intern_src[-1])
  85
  86 #ifdef ARCH_SIXTYFOUR
  87 static intnat read64s(void)
  88 {
  89   intnat res;
  90   int i;
  91   res = 0;
  92   for (i = 0; i < 8; i++) res = (res << 8) + intern_src[i];
  93   intern_src += 8;
  94   return res;
  95 }
  96 #endif
  97
  98 #define readblock(dest,len) \
  99   (memmove((dest), intern_src, (len)), intern_src += (len))
 100
 101 static void intern_cleanup(void)
 102 {
 103   if (intern_input_malloced) caml_stat_free(intern_input);
 104   if (intern_obj_table != NULL) caml_stat_free(intern_obj_table);
 105   if (intern_extra_block != NULL) {
 106     /* free newly allocated heap chunk */
 107     caml_free_for_heap(intern_extra_block);
 108   } else if (intern_block != 0) {
 109     /* restore original header for heap block, otherwise GC is confused */
 110     Hd_val(intern_block) = intern_header;
 111   }
 112 }
 113
 114 static void intern_rec(value *dest)
 115 {
 116   unsigned int code;
 117   tag_t tag;
 118   mlsize_t size, len, ofs_ind;
 119   value v, clos;
 120   asize_t ofs;
 121   header_t header;
 122   char cksum[16];
 123   struct custom_operations * ops;
 124
 125  tailcall:
 126   code = read8u();
 127   if (code >= PREFIX_SMALL_INT) {
 128     if (code >= PREFIX_SMALL_BLOCK) {
 129       /* Small block */
 130       tag = code & 0xF;
 131       size = (code >> 4) & 0x7;
 132     read_block:
 133       if (size == 0) {
 134         v = Atom(tag);
 135       } else {
 136         v = Val_hp(intern_dest);
 137         *dest = v;
 138         if (intern_obj_table != NULL) intern_obj_table[obj_counter++] = v;
 139         dest = (value *) (intern_dest + 1);
 140         *intern_dest = Make_header(size, tag, intern_color);
 141         intern_dest += 1 + size;
 142         for(/*nothing*/; size > 1; size--, dest++)
 143           intern_rec(dest);
 144         goto tailcall;
 145       }
 146     } else {
 147       /* Small integer */
 148       v = Val_int(code & 0x3F);
 149     }
 150   } else {
 151     if (code >= PREFIX_SMALL_STRING) {
 152       /* Small string */
 153       len = (code & 0x1F);
 154     read_string:
 155       size = (len + sizeof(value)) / sizeof(value);
 156       v = Val_hp(intern_dest);
 157       if (intern_obj_table != NULL) intern_obj_table[obj_counter++] = v;
 158       *intern_dest = Make_header(size, String_tag, intern_color);
 159       intern_dest += 1 + size;
 160       Field(v, size - 1) = 0;
 161       ofs_ind = Bsize_wsize(size) - 1;
 162       Byte(v, ofs_ind) = ofs_ind - len;
 163       readblock(String_val(v), len);
 164     } else {
 165       switch(code) {
 166       case CODE_INT8:
 167         v = Val_long(read8s());
 168         break;
 169       case CODE_INT16:
 170         v = Val_long(read16s());
 171         break;
 172       case CODE_INT32:
 173         v = Val_long(read32s());
 174         break;
 175       case CODE_INT64:
 176 #ifdef ARCH_SIXTYFOUR
 177         v = Val_long(read64s());
 178         break;
 179 #else
 180         intern_cleanup();
 181         caml_failwith("input_value: integer too large");
 182         break;
 183 #endif
 184       case CODE_SHARED8:
 185         ofs = read8u();
 186       read_shared:
 187         Assert (ofs > 0);
 188         Assert (ofs <= obj_counter);
 189         Assert (intern_obj_table != NULL);
 190         v = intern_obj_table[obj_counter - ofs];
 191         break;
 192       case CODE_SHARED16:
 193         ofs = read16u();
 194         goto read_shared;
 195       case CODE_SHARED32:
 196         ofs = read32u();
 197         goto read_shared;
 198       case CODE_BLOCK32:
 199         header = (header_t) read32u();
 200         tag = Tag_hd(header);
 201         size = Wosize_hd(header);
 202         goto read_block;
 203       case CODE_BLOCK64:
 204 #ifdef ARCH_SIXTYFOUR
 205         header = (header_t) read64s();
 206         tag = Tag_hd(header);
 207         size = Wosize_hd(header);
 208         goto read_block;
 209 #else
 210         intern_cleanup();
 211         caml_failwith("input_value: data block too large");
 212         break;
 213 #endif
 214       case CODE_STRING8:
 215         len = read8u();
 216         goto read_string;
 217       case CODE_STRING32:
 218         len = read32u();
 219         goto read_string;
 220       case CODE_DOUBLE_LITTLE:
 221       case CODE_DOUBLE_BIG:
 222         if (sizeof(double) != 8) {
 223           intern_cleanup();
 224           caml_invalid_argument("input_value: non-standard floats");
 225         }
 226         v = Val_hp(intern_dest);
 227         if (intern_obj_table != NULL) intern_obj_table[obj_counter++] = v;
 228         *intern_dest = Make_header(Double_wosize, Double_tag, intern_color);
 229         intern_dest += 1 + Double_wosize;
 230         readblock((char *) v, 8);
 231 #if ARCH_FLOAT_ENDIANNESS == 0x76543210
 232         if (code != CODE_DOUBLE_BIG) Reverse_64(v, v);
 233 #elif ARCH_FLOAT_ENDIANNESS == 0x01234567
 234         if (code != CODE_DOUBLE_LITTLE) Reverse_64(v, v);
 235 #else
 236         if (code == CODE_DOUBLE_LITTLE)
 237           Permute_64(v, ARCH_FLOAT_ENDIANNESS, v, 0x01234567)
 238         else
 239           Permute_64(v, ARCH_FLOAT_ENDIANNESS, v, 0x76543210);
 240 #endif
 241         break;
 242       case CODE_DOUBLE_ARRAY8_LITTLE:
 243       case CODE_DOUBLE_ARRAY8_BIG:
 244         len = read8u();
 245       read_double_array:
 246         if (sizeof(double) != 8) {
 247           intern_cleanup();
 248           caml_invalid_argument("input_value: non-standard floats");
 249         }
 250         size = len * Double_wosize;
 251         v = Val_hp(intern_dest);
 252         if (intern_obj_table != NULL) intern_obj_table[obj_counter++] = v;
 253         *intern_dest = Make_header(size, Double_array_tag, intern_color);
 254         intern_dest += 1 + size;
 255         readblock((char *) v, len * 8);
 256 #if ARCH_FLOAT_ENDIANNESS == 0x76543210
 257         if (code != CODE_DOUBLE_ARRAY8_BIG &&
 258             code != CODE_DOUBLE_ARRAY32_BIG) {
 259           mlsize_t i;
 260           for (i = 0; i < len; i++) Reverse_64((value)((double *)v + i),
 261                                                (value)((double *)v + i));
 262         }
 263 #elif ARCH_FLOAT_ENDIANNESS == 0x01234567
 264         if (code != CODE_DOUBLE_ARRAY8_LITTLE &&
 265             code != CODE_DOUBLE_ARRAY32_LITTLE) {
 266           mlsize_t i;
 267           for (i = 0; i < len; i++) Reverse_64((value)((double *)v + i),
 268                                                (value)((double *)v + i));
 269         }
 270 #else
 271         if (code == CODE_DOUBLE_ARRAY8_LITTLE ||
 272             code == CODE_DOUBLE_ARRAY32_LITTLE) {
 273           mlsize_t i;
 274           for (i = 0; i < len; i++)
 275             Permute_64((value)((double *)v + i), ARCH_FLOAT_ENDIANNESS,
 276                        (value)((double *)v + i), 0x01234567);
 277         } else {
 278           mlsize_t i;
 279           for (i = 0; i < len; i++)
 280             Permute_64((value)((double *)v + i), ARCH_FLOAT_ENDIANNESS,
 281                        (value)((double *)v + i), 0x76543210);
 282         }
 283 #endif
 284         break;
 285       case CODE_DOUBLE_ARRAY32_LITTLE:
 286       case CODE_DOUBLE_ARRAY32_BIG:
 287         len = read32u();
 288         goto read_double_array;
 289       case CODE_CODEPOINTER:
 290         ofs = read32u();
 291         readblock(cksum, 16);
 292         if (memcmp(cksum, caml_code_checksum(), 16) != 0) {
 293           intern_cleanup();
 294           caml_failwith("input_value: code mismatch");
 295         }
 296         v = (value) (caml_code_area_start + ofs);
 297         break;
 298       case CODE_INFIXPOINTER:
 299         ofs = read32u();
 300         intern_rec(&clos);
 301         v = clos + ofs;
 302         break;
 303       case CODE_CUSTOM:
 304         ops = caml_find_custom_operations((char *) intern_src);
 305         if (ops == NULL) {
 306           intern_cleanup();
 307           caml_failwith("input_value: unknown custom block identifier");
 308         }
 309         while (*intern_src++ != 0) /*nothing*/;  /*skip identifier*/
 310         size = ops->deserialize((void *) (intern_dest + 2));
 311         size = 1 + (size + sizeof(value) - 1) / sizeof(value);
 312         v = Val_hp(intern_dest);
 313         if (intern_obj_table != NULL) intern_obj_table[obj_counter++] = v;
 314         *intern_dest = Make_header(size, Custom_tag, intern_color);
 315         Custom_ops_val(v) = ops;
 316         intern_dest += 1 + size;
 317         break;
 318       default:
 319         intern_cleanup();
 320         caml_failwith("input_value: ill-formed message");
 321       }
 322     }
 323   }
 324   *dest = v;
 325 }
 326
 327 static void intern_alloc(mlsize_t whsize, mlsize_t num_objects)
 328 {
 329   mlsize_t wosize;
 330
 331   if (whsize == 0) {
 332     intern_obj_table = NULL;
 333     intern_extra_block = NULL;
 334     intern_block = 0;
 335     return;
 336   }
 337   wosize = Wosize_whsize(whsize);
 338   if (wosize > Max_wosize) {
 339     /* Round desired size up to next page */
 340     asize_t request =
 341       ((Bsize_wsize(whsize) + Page_size - 1) >> Page_log) << Page_log;
 342     intern_extra_block = caml_alloc_for_heap(request);
 343     if (intern_extra_block == NULL) caml_raise_out_of_memory();
 344     intern_color = caml_allocation_color(intern_extra_block);
 345     intern_dest = (header_t *) intern_extra_block;
 346   } else {
 347     /* this is a specialised version of caml_alloc from alloc.c */
 348     if (wosize == 0){
 349       intern_block = Atom (String_tag);
 350     }else if (wosize <= Max_young_wosize){
 351       intern_block = caml_alloc_small (wosize, String_tag);
 352     }else{
 353       intern_block = caml_alloc_shr (wosize, String_tag);
 354       /* do not do the urgent_gc check here because it might darken
 355          intern_block into gray and break the Assert 3 lines down */
 356     }
 357     intern_header = Hd_val(intern_block);
 358     intern_color = Color_hd(intern_header);
 359     Assert (intern_color == Caml_white || intern_color == Caml_black);
 360     intern_dest = (header_t *) Hp_val(intern_block);
 361     intern_extra_block = NULL;
 362   }
 363   obj_counter = 0;
 364   if (num_objects > 0)
 365     intern_obj_table = (value *) caml_stat_alloc(num_objects * sizeof(value));
 366   else
 367     intern_obj_table = NULL;
 368 }
 369
 370 static void intern_add_to_heap(mlsize_t whsize)
 371 {
 372   /* Add new heap chunk to heap if needed */
 373   if (intern_extra_block != NULL) {
 374     /* If heap chunk not filled totally, build free block at end */
 375     asize_t request =
 376       ((Bsize_wsize(whsize) + Page_size - 1) >> Page_log) << Page_log;
 377     header_t * end_extra_block =
 378       (header_t *) intern_extra_block + Wsize_bsize(request);
 379     Assert(intern_dest <= end_extra_block);
 380     if (intern_dest < end_extra_block){
 381       caml_make_free_blocks ((value *) intern_dest,
 382                              end_extra_block - intern_dest, 0);
 383     }
 384     caml_allocated_words +=
 385       Wsize_bsize ((char *) intern_dest - intern_extra_block);
 386     caml_add_to_heap(intern_extra_block);
 387   }
 388 }
 389
 390 value caml_input_val(struct channel *chan)
 391 {
 392   uint32 magic;
 393   mlsize_t block_len, num_objects, size_32, size_64, whsize;
 394   char * block;
 395   value res;
 396
 397   if (! caml_channel_binary_mode(chan))
 398     caml_failwith("input_value: not a binary channel");
 399   magic = caml_getword(chan);
 400   if (magic != Intext_magic_number) caml_failwith("input_value: bad object");
 401   block_len = caml_getword(chan);
 402   num_objects = caml_getword(chan);
 403   size_32 = caml_getword(chan);
 404   size_64 = caml_getword(chan);
 405   /* Read block from channel */
 406   block = caml_stat_alloc(block_len);
 407   /* During [caml_really_getblock], concurrent [caml_input_val] operations
 408      can take place (via signal handlers or context switching in systhreads),
 409      and [intern_input] may change.  So, wait until [caml_really_getblock]
 410      is over before using [intern_input] and the other global vars. */
 411   if (caml_really_getblock(chan, block, block_len) == 0) {
 412     caml_stat_free(block);
 413     caml_failwith("input_value: truncated object");
 414   }
 415   intern_input = (unsigned char *) block;
 416   intern_input_malloced = 1;
 417   intern_src = intern_input;
 418   /* Allocate result */
 419 #ifdef ARCH_SIXTYFOUR
 420   whsize = size_64;
 421 #else
 422   whsize = size_32;
 423 #endif
 424   intern_alloc(whsize, num_objects);
 425   /* Fill it in */
 426   intern_rec(&res);
 427   intern_add_to_heap(whsize);
 428   /* Free everything */
 429   caml_stat_free(intern_input);
 430   if (intern_obj_table != NULL) caml_stat_free(intern_obj_table);
 431   return res;
 432 }
 433
 434 CAMLprim value caml_input_value(value vchan)
 435 {
 436   CAMLparam1 (vchan);
 437   struct channel * chan = Channel(vchan);
 438   CAMLlocal1 (res);
 439
 440   Lock(chan);
 441   res = caml_input_val(chan);
 442   Unlock(chan);
 443   CAMLreturn (res);
 444 }
 445
 446 CAMLexport value caml_input_val_from_string(value str, intnat ofs)
 447 {
 448   CAMLparam1 (str);
 449   mlsize_t num_objects, size_32, size_64, whsize;
 450   CAMLlocal1 (obj);
 451
 452   intern_src = &Byte_u(str, ofs + 2*4);
 453   intern_input_malloced = 0;
 454   num_objects = read32u();
 455   size_32 = read32u();
 456   size_64 = read32u();
 457   /* Allocate result */
 458 #ifdef ARCH_SIXTYFOUR
 459   whsize = size_64;
 460 #else
 461   whsize = size_32;
 462 #endif
 463   intern_alloc(whsize, num_objects);
 464   intern_src = &Byte_u(str, ofs + 5*4); /* If a GC occurred */
 465   /* Fill it in */
 466   intern_rec(&obj);
 467   intern_add_to_heap(whsize);
 468   /* Free everything */
 469   if (intern_obj_table != NULL) caml_stat_free(intern_obj_table);
 470   CAMLreturn (obj);
 471 }
 472
 473 CAMLprim value caml_input_value_from_string(value str, value ofs)
 474 {
 475   return caml_input_val_from_string(str, Long_val(ofs));
 476 }
 477
 478 static value input_val_from_block(void)
 479 {
 480   mlsize_t num_objects, size_32, size_64, whsize;
 481   value obj;
 482
 483   num_objects = read32u();
 484   size_32 = read32u();
 485   size_64 = read32u();
 486   /* Allocate result */
 487 #ifdef ARCH_SIXTYFOUR
 488   whsize = size_64;
 489 #else
 490   whsize = size_32;
 491 #endif
 492   intern_alloc(whsize, num_objects);
 493   /* Fill it in */
 494   intern_rec(&obj);
 495   intern_add_to_heap(whsize);
 496   /* Free internal data structures */
 497   if (intern_obj_table != NULL) caml_stat_free(intern_obj_table);
 498   return obj;
 499 }
 500
 501 CAMLexport value caml_input_value_from_malloc(char * data, intnat ofs)
 502 {
 503   uint32 magic;
 504   mlsize_t block_len;
 505   value obj;
 506
 507   intern_input = (unsigned char *) data;
 508   intern_src = intern_input + ofs;
 509   intern_input_malloced = 1;
 510   magic = read32u();
 511   if (magic != Intext_magic_number)
 512     caml_failwith("input_value_from_malloc: bad object");
 513   block_len = read32u();
 514   obj = input_val_from_block();
 515   /* Free the input */
 516   caml_stat_free(intern_input);
 517   return obj;
 518 }
 519
 520 CAMLexport value caml_input_value_from_block(char * data, intnat len)
 521 {
 522   uint32 magic;
 523   mlsize_t block_len;
 524   value obj;
 525
 526   intern_input = (unsigned char *) data;
 527   intern_src = intern_input;
 528   intern_input_malloced = 0;
 529   magic = read32u();
 530   if (magic != Intext_magic_number)
 531     caml_failwith("input_value_from_block: bad object");
 532   block_len = read32u();
 533   if (5*4 + block_len > len)
 534     caml_failwith("input_value_from_block: bad block length");
 535   obj = input_val_from_block();
 536   return obj;
 537 }
 538
 539 CAMLprim value caml_marshal_data_size(value buff, value ofs)
 540 {
 541   uint32 magic;
 542   mlsize_t block_len;
 543
 544   intern_src = &Byte_u(buff, Long_val(ofs));
 545   intern_input_malloced = 0;
 546   magic = read32u();
 547   if (magic != Intext_magic_number){
 548     caml_failwith("Marshal.data_size: bad object");
 549   }
 550   block_len = read32u();
 551   return Val_long(block_len);
 552 }
 553
 554 /* Return an MD5 checksum of the code area */
 555
 556 #ifdef NATIVE_CODE
 557
 558 #include "md5.h"
 559
 560 unsigned char * caml_code_checksum(void)
 561 {
 562   static unsigned char checksum[16];
 563   static int checksum_computed = 0;
 564
 565   if (! checksum_computed) {
 566     struct MD5Context ctx;
 567     caml_MD5Init(&ctx);
 568     caml_MD5Update(&ctx,
 569                    (unsigned char *) caml_code_area_start,
 570                    caml_code_area_end - caml_code_area_start);
 571     caml_MD5Final(checksum, &ctx);
 572     checksum_computed = 1;
 573   }
 574   return checksum;
 575 }
 576
 577 #else
 578
 579 #include "fix_code.h"
 580
 581 unsigned char * caml_code_checksum(void)
 582 {
 583   return caml_code_md5;
 584 }
 585
 586 #endif
 587
 588 /* Functions for writing user-defined marshallers */
 589
 590 CAMLexport int caml_deserialize_uint_1(void)
 591 {
 592   return read8u();
 593 }
 594
 595 CAMLexport int caml_deserialize_sint_1(void)
 596 {
 597   return read8s();
 598 }
 599
 600 CAMLexport int caml_deserialize_uint_2(void)
 601 {
 602   return read16u();
 603 }
 604
 605 CAMLexport int caml_deserialize_sint_2(void)
 606 {
 607   return read16s();
 608 }
 609
 610 CAMLexport uint32 caml_deserialize_uint_4(void)
 611 {
 612   return read32u();
 613 }
 614
 615 CAMLexport int32 caml_deserialize_sint_4(void)
 616 {
 617   return read32s();
 618 }
 619
 620 CAMLexport uint64 caml_deserialize_uint_8(void)
 621 {
 622   uint64 i;
 623   caml_deserialize_block_8(&i, 1);
 624   return i;
 625 }
 626
 627 CAMLexport int64 caml_deserialize_sint_8(void)
 628 {
 629   int64 i;
 630   caml_deserialize_block_8(&i, 1);
 631   return i;
 632 }
 633
 634 CAMLexport float caml_deserialize_float_4(void)
 635 {
 636   float f;
 637   caml_deserialize_block_4(&f, 1);
 638   return f;
 639 }
 640
 641 CAMLexport double caml_deserialize_float_8(void)
 642 {
 643   double f;
 644   caml_deserialize_block_float_8(&f, 1);
 645   return f;
 646 }
 647
 648 CAMLexport void caml_deserialize_block_1(void * data, intnat len)
 649 {
 650   memmove(data, intern_src, len);
 651   intern_src += len;
 652 }
 653
 654 CAMLexport void caml_deserialize_block_2(void * data, intnat len)
 655 {
 656 #ifndef ARCH_BIG_ENDIAN
 657   unsigned char * p, * q;
 658   for (p = intern_src, q = data; len > 0; len--, p += 2, q += 2)
 659     Reverse_16(q, p);
 660   intern_src = p;
 661 #else
 662   memmove(data, intern_src, len * 2);
 663   intern_src += len * 2;
 664 #endif
 665 }
 666
 667 CAMLexport void caml_deserialize_block_4(void * data, intnat len)
 668 {
 669 #ifndef ARCH_BIG_ENDIAN
 670   unsigned char * p, * q;
 671   for (p = intern_src, q = data; len > 0; len--, p += 4, q += 4)
 672     Reverse_32(q, p);
 673   intern_src = p;
 674 #else
 675   memmove(data, intern_src, len * 4);
 676   intern_src += len * 4;
 677 #endif
 678 }
 679
 680 CAMLexport void caml_deserialize_block_8(void * data, intnat len)
 681 {
 682 #ifndef ARCH_BIG_ENDIAN
 683   unsigned char * p, * q;
 684   for (p = intern_src, q = data; len > 0; len--, p += 8, q += 8)
 685     Reverse_64(q, p);
 686   intern_src = p;
 687 #else
 688   memmove(data, intern_src, len * 8);
 689   intern_src += len * 8;
 690 #endif
 691 }
 692
 693 CAMLexport void caml_deserialize_block_float_8(void * data, intnat len)
 694 {
 695 #if ARCH_FLOAT_ENDIANNESS == 0x01234567
 696   memmove(data, intern_src, len * 8);
 697   intern_src += len * 8;
 698 #elif ARCH_FLOAT_ENDIANNESS == 0x76543210
 699   unsigned char * p, * q;
 700   for (p = intern_src, q = data; len > 0; len--, p += 8, q += 8)
 701     Reverse_64(q, p);
 702   intern_src = p;
 703 #else
 704   unsigned char * p, * q;
 705   for (p = intern_src, q = data; len > 0; len--, p += 8, q += 8)
 706     Permute_64(q, ARCH_FLOAT_ENDIANNESS, p, 0x01234567);
 707   intern_src = p;
 708 #endif
 709 }
 710
 711 CAMLexport void caml_deserialize_error(char * msg)
 712 {
 713   intern_cleanup();
 714   caml_failwith(msg);
 715 }