/* 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(chan, nbytes, sign_extend)
     struct channel * chan;
     int nbytes, 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(chan, dest)
     struct channel * chan;
     value * dest;
{
  unsigned int code;
  tag_t tag;
  mlsize_t size, len, ofs_ind;
  value v;
  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 CAML_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 CAML_BIG_ENDIAN
        Reverse_double(v);
#endif
        break;
      }
    }
  }
  *dest = v;
}

value intern_compact_val(chan)
     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 CAML_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;
}
