/* s11n-c.c */

/* argvector chicken starts with version 8 */
#if C_BINARY_VERSION >= 8
# define ARGVECTOR_CHICKEN
#endif

/* Messy macros to easily support pre- and post-argvector CHICKENs */
#ifdef ARGVECTOR_CHICKEN
# define CPS_PROC1(name, c, s, k, a1) name(C_word c, C_word *__av)
# define CPS_BODY1(c, s, k, a1) C_word s = __av[0]; C_word k = __av[1]; C_word a1 = c >= 1 ? __av[2] : 0;
#else
# define CPS_PROC1(name, c, s, k, a1) name(C_word c, C_word s, C_word k, C_word a1)
# define CPS_BODY1(c, s, k, a1) /* Nothing */
#endif

static void CPS_PROC1(fixnum_to_bytes, c, self, k, x)
{
  CPS_BODY1(c, self, k, x);
  C_word *a = C_alloc(C_SIZEOF_STRING(sizeof(C_word)));
  C_kontinue(k, C_string(&a, sizeof(C_word), (C_char *)&x));
}

static void CPS_PROC1(word_to_bytes, c, self, k, x)
{
  CPS_BODY1(c, self, k, x);
  C_word *a = C_alloc(C_SIZEOF_STRING(sizeof(unsigned long)));
  unsigned long n = C_num_to_unsigned_long(x);
  C_kontinue(k, C_string(&a, sizeof(unsigned long), (C_char *)&n));
}

static void CPS_PROC1(header_to_bytes, c, self, k, x)
{
  CPS_BODY1(c, self, k, x);
  C_word *a = C_alloc(C_SIZEOF_STRING(sizeof(C_header)));
  C_kontinue(k, C_string(&a, sizeof(C_header), (C_char *)x));
}

static void CPS_PROC1(bytes_to_block, c, self, k, str)
{
  CPS_BODY1(c, self, k, str);
  C_header h = *((C_header *)C_data_pointer(str));  
  int size = h & C_HEADER_SIZE_MASK;
#ifdef ARGVECTOR_CHICKEN
  C_word av[6];

  av[ 0 ] = C_SCHEME_UNDEFINED;
  av[ 1 ] = k;
  av[ 2 ] = C_fix(size);
  av[ 3 ] = C_mk_bool((h & C_BYTEBLOCK_BIT) != 0);
  av[ 4 ] = C_SCHEME_FALSE;
  av[ 5 ] = C_mk_bool((h & C_8ALIGN_BIT) != 0);
  C_allocate_vector(6, av);
#else
  C_allocate_vector(6, C_SCHEME_UNDEFINED, k, C_fix(size), C_mk_bool((h & C_BYTEBLOCK_BIT) != 0),
		       C_SCHEME_FALSE, C_mk_bool((h & C_8ALIGN_BIT) != 0));
#endif
}

static C_word bytes_to_size(C_word str)
{
  C_header h = *((C_header *)C_data_pointer(str));  

  return C_fix(h & C_HEADER_SIZE_MASK);
}

static C_word bytes_to_word(C_word str)
{
  return C_fix(*((unsigned long *)C_data_pointer(str)));
}

static C_word insert_bytes(C_word x, C_word str)
{
  C_memcpy(C_data_pointer(x), C_data_pointer(str), C_header_size(str));
  return C_SCHEME_UNDEFINED;
}

static C_word set_procedure_ptr(C_word x, C_word pid)
{
  void *ptr = C_lookup_procedure_ptr(C_c_string(pid));

  if(ptr != NULL) {
    C_block_item(x, 0) = (C_word)ptr;
    return C_SCHEME_TRUE;
  }
  else return C_SCHEME_FALSE;
}

static C_word bytes_to_fixnum(C_word str)
{
  return *((C_word *)C_data_pointer(str));
}

static C_word set_header(C_word x, C_word str)
{
  C_block_header(x) = *((C_header *)C_data_pointer(str));
  return x;
}