/* Structured input, compact format */ #include "debugger.h"#include "fail.h"#include "gc.h"#include "intext.h"#include "io.h"#include "memory.h"#include "mlvalues.h"#include "reverse.h" static header_t * intern_ptr;static asize_t obj_counter;static value * intern_obj_table;static unsigned int intern_color;static header_t intern_header;static value intern_block; static long input_bytes(struct channel * chan, int nbytes, int sign_extend){  long res;  int i;  res = getch(chan);  if (sign_extend)    res = (res << ((sizeof(long) - 1) * 8)) >> ((sizeof(long) - 1) * 8);  for (i = 1; i < nbytes; i++)    res = (res << 8) + getch(chan);  return res;} static void read_compact(struct channel * chan, value * dest){  unsigned int code;  tag_t tag;  mlsize_t size, len, ofs_ind;  value v = Val_unit;  asize_t ofs;  header_t header;  tailcall:  code = getch(chan);  if (code >= PREFIX_SMALL_INT) {    if (code >= PREFIX_SMALL_BLOCK) {      /* Small block */      tag = code & 0xF;      size = (code >> 4) & 0x7;    read_block:      if (size == 0) {        v = Atom(tag);      } else {        v = Val_hp(intern_ptr);        *dest = v;        intern_obj_table[obj_counter++] = v;        dest = (value *) (intern_ptr + 1);        *intern_ptr = Make_header(size, tag, intern_color);        intern_ptr += 1 + size;        for(/*nothing*/; size > 1; size--, dest++)          read_compact(chan, dest);        goto tailcall;      }    } else {      /* Small integer */      v = Val_int(code & 0x3F);    }  } else {    if (code >= PREFIX_SMALL_STRING) {      /* Small string */      len = (code & 0x1F);    read_string:      size = (len + sizeof(value)) / sizeof(value);      v = Val_hp(intern_ptr);      intern_obj_table[obj_counter++] = v;      *intern_ptr = Make_header(size, String_tag, intern_color);      intern_ptr += 1 + size;      Field(v, size - 1) = 0;      ofs_ind = Bsize_wsize(size) - 1;      Byte(v, ofs_ind) = ofs_ind - len;      really_getblock(chan, String_val(v), len);    } else {      switch(code) {      case CODE_INT8:        v = Val_long(input_bytes(chan, 1, 1));        break;      case CODE_INT16:        v = Val_long(input_bytes(chan, 2, 1));        break;      case CODE_INT32:        v = Val_long(input_bytes(chan, 4, 1));        break;      case CODE_INT64:#ifdef SIXTYFOUR        v = Val_long(input_bytes(chan, 8, 1));        break;#else        stat_free((char *) intern_obj_table);        Hd_val(intern_block) = intern_header; /* Don't confuse the GC */        failwith("input_value: integer too large");        break;#endif      case CODE_SHARED8:        ofs = input_bytes(chan, 1, 0);      read_shared:        Assert(ofs > 0 && ofs <= obj_counter);         v = intern_obj_table[obj_counter - ofs];        break;      case CODE_SHARED16:        ofs = input_bytes(chan, 2, 0);        goto read_shared;      case CODE_SHARED32:        ofs = input_bytes(chan, 4, 0);        goto read_shared;      case CODE_BLOCK32:        header = (header_t) input_bytes(chan, 4, 0);        tag = Tag_hd(header);        size = Wosize_hd(header);        goto read_block;      case CODE_STRING8:        len = input_bytes(chan, 1, 0);        goto read_string;      case CODE_STRING32:        len = input_bytes(chan, 4, 0);        goto read_string;      case CODE_DOUBLE:        if (sizeof(double) != 8) {          stat_free((char *) intern_obj_table);          Hd_val(intern_block) = intern_header; /* Don't confuse the GC */          invalid_argument("input_value: non-standard floats");        }        v = Val_hp(intern_ptr);        intern_obj_table[obj_counter++] = v;        *intern_ptr = Make_header(Double_wosize, Double_tag, intern_color);        intern_ptr += 1 + Double_wosize;        really_getblock(chan, (char *) v, 8);#ifndef MOSML_BIG_ENDIAN        Reverse_double(v);#endif        break;      }    }  }  *dest = v;} value intern_compact_val(struct channel * chan){  mlsize_t num_objects, size_32, size_64, whsize;  value res;   num_objects = getword(chan);  size_32 = getword(chan);  size_64 = getword(chan);#ifdef SIXTYFOUR  whsize = size_64;#else  whsize = size_32;#endif  if (whsize == 0) {    read_compact(chan, &res);  } else {    if (Wosize_whsize(whsize) > Max_wosize)      failwith("intern: structure too big");    intern_block = alloc_shr(Wosize_whsize(whsize), String_tag);    intern_header = Hd_val(intern_block);    intern_color = Color_hd(intern_header);    Assert (intern_color == White || intern_color == Black);    intern_ptr = (header_t *) Hp_val(intern_block);    obj_counter = 0;    intern_obj_table = (value *) stat_alloc(num_objects * sizeof(value));    read_compact(chan, &res);    stat_free((char *) intern_obj_table);  }  return res;}