/* numbers-c.c
 *
 * Copyright 2010-2014 The CHICKEN Team
 *
 * This contains a barely recognizable version of c/bignum.c from Scheme48 1.8:
 * Copyright (c) 1993-2008 Richard Kelsey and Jonathan Rees
 * Copyright 1986,1987,1988,1989,1990,1991 Massachusetts Institute of Technology
 * Copyright 1992,1993,1994,2004 Massachusetts Institute of Technology
 *
 * Redistribution and use in source and binary forms, with or without
 * modification, are permitted provided that the following conditions are
 * met:
 *
 *    1. Redistributions of source code must retain the above copyright
 *       notice, this list of conditions and the following disclaimer.
 * 
 *    2. Redistributions in binary form must reproduce the above
 *       copyright notice, this list of conditions and the following
 *       disclaimer in the documentation and/or other materials provided
 *       with the distribution.
 * 
 *    3. The name of the author may not be used to endorse or promote
 *       products derived from this software without specific prior
 *       written permission.
 *
 * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR
 * IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
 * WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
 * DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT,
 * INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
 * (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
 * SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
 * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
 * STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING
 * IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
 * POSSIBILITY OF SUCH DAMAGE.
 */

#include <assert.h>
#include <errno.h>
#include <math.h> /* frexp() */

#define nmax(x, y)     ((x) > (y) ? (x) : (y)) /* From runtime.c */
#define free_tmp_bignum(b)    C_free((void *)(b))

static void *tags;

#include "numbers-c.h"

static C_word init_tags(___scheme_value tagvec);
static void bignum_negate_2(C_word c, C_word self, C_word new_big) C_noret;
static void allocate_bignum_2(C_word c, C_word self, C_word bigvec) C_noret;
static C_word allocate_tmp_bignum(C_word size, C_word negp, C_word initp);
static C_uword bignum_digits_destructive_scale_up_with_carry(C_uword *start, C_uword *end, C_uword fix_factor, C_uword carry);
static C_uword bignum_digits_destructive_scale_down(C_uword *start, C_uword *end, C_uword denominator);
static C_uword bignum_digits_destructive_shift_right(C_uword *start, C_uword *end, int shift_right);
static C_uword bignum_digits_destructive_shift_left(C_uword *start, C_uword *end, int shift_left);
static void bignum_plus_unsigned(C_word k, C_word x, C_word y, C_word negp) C_noret;
static void bignum_plus_unsigned_2(C_word c, C_word self, C_word result) C_noret;
static C_word int_flo_cmp(C_word intnum, C_word flonum);
static C_word flo_int_cmp(C_word flonum, C_word intnum);
static int bignum_cmp_unsigned(C_word x, C_word y);
static void bignum_minus_unsigned(C_word k, C_word x, C_word y) C_noret;
static void bignum_minus_unsigned_2(C_word c, C_word self, C_word result) C_noret;
static void integer_times_2(C_word c, C_word self, C_word new_big) C_noret;
static C_regparm void bignum_digits_multiply(C_word x, C_word y, C_word result);
static void bignum_times_bignum_unsigned(C_word k, C_word x, C_word y, C_word negp) C_noret;
static void bignum_times_bignum_unsigned_2(C_word c, C_word self, C_word result) C_noret;
static void digits_to_integer_2(C_word c, C_word self, C_word result) C_noret;
static void bignum_to_digits_2(C_word c, C_word self, C_word string) C_noret;
static void fabs_frexp_to_digits(C_uword exp, double sign, C_uword *start, C_uword *scan);
static C_word flo_to_tmp_bignum(C_word x);
static void flo_to_int_2(C_word c, C_word self, C_word result) C_noret;
static void bignum_allocate_for_shift(C_word c, C_word self, C_word x) C_noret;
static void bignum_negate_after_shift(C_word c, C_word self, C_word result) C_noret;
static void bignum_actual_shift(C_word c, C_word self, C_word result) C_noret;
static void bignum_allocate_for_extraction(C_word c, C_word self, C_word x) C_noret;
static void bignum_actual_extraction(C_word c, C_word self, C_word result) C_noret;
static void bignum_random_2(C_word c, C_word self, C_word result) C_noret;
static void bignum_maybe_negate_magnitude(C_word k, C_word result) C_noret;
static C_regparm void basic_divrem(C_word c, C_word self, C_word k, C_word loc, C_word x, C_word y, C_word return_r, C_word return_q) C_noret;
static C_regparm void integer_divrem(C_word c, C_word self, C_word k, C_word loc, C_word x, C_word y, C_word return_q, C_word return_r) C_noret;
static C_regparm void bignum_divrem(C_word c, C_word self, C_word k, C_word x, C_word y, C_word return_q, C_word return_r) C_noret;
static void divrem_intflo(C_word c, C_word self, C_word intnum) C_noret;
static void divrem_intflo_2(C_word c, C_word self, ...) C_noret;
static void bignum_divrem_fixnum_2(C_word c, C_word self, C_word negated_big) C_noret;
static void bignum_negneg_bitwise_op(C_word c, C_word self, C_word result) C_noret;
static void bignum_posneg_bitwise_op(C_word c, C_word self, C_word result) C_noret;
static void bignum_pospos_bitwise_op(C_word c, C_word self, C_word result) C_noret;
static void bignum_destructive_normalize(C_word target, C_word source, int shift_left);
static C_word bignum_remainder_unsigned_halfdigit(C_word num, C_word den);
static void bignum_destructive_divide_unsigned_small(C_word c, C_word self, C_word quotient);
static void bignum_divide_2_unsigned(C_word c, C_word self, C_word quotient) C_noret;
static void bignum_divide_2_unsigned_2(C_word c, C_word self, C_word remainder) C_noret;
static void bignum_destructive_divide_normalized(C_word big_u, C_word big_v, C_word big_q);

static void barf(int code, char *loc, ...) C_noret;
static void try_extended_number(char *ext_proc_name, C_word c, C_word k, ...) C_noret;

/* XXX THIS IS DUPLICATED HERE FROM runtime.c, but should be ripped out */
static void barf(int code, char *loc, ...)
{
  char *msg;
  int c, i;
  va_list v;
  /* Just take a random size that will "always" fit... */
  C_word err, ab[C_SIZEOF_STRING(64)], *a = ab;

  err = C_lookup_symbol(C_intern2(&a, C_text("\003syserror-hook")));

  switch(code) {
  case C_BAD_ARGUMENT_COUNT_ERROR:
    msg = C_text("bad argument count");
    c = 3;
    break;

  case C_BAD_MINIMUM_ARGUMENT_COUNT_ERROR:
    msg = C_text("too few arguments");
    c = 3;
    break;
  
  case C_BAD_ARGUMENT_TYPE_ERROR:
    msg = C_text("bad argument type");
    c = 1;
    break;

  case C_DIVISION_BY_ZERO_ERROR:
    msg = C_text("division by zero");
    c = 0;
    break;

  case C_OUT_OF_RANGE_ERROR:
    msg = C_text("out of range");
    c = 2;
    break;

  case C_CANT_REPRESENT_INEXACT_ERROR:
    msg = C_text("inexact number cannot be represented as an exact number");
    c = 1;
    break;

  case C_BAD_ARGUMENT_TYPE_NO_FIXNUM_ERROR:
    msg = C_text("bad argument type - not a fixnum");
    c = 1;
    break;

  case C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR:
    msg = C_text("bad argument type - not a number");
    c = 1;
    break;

  case C_BAD_ARGUMENT_TYPE_NO_INTEGER_ERROR:
    msg = C_text("bad argument type - not an integer");
    c = 1;
    break;

  case C_BAD_ARGUMENT_TYPE_NO_UINTEGER_ERROR:
    msg = C_text("bad argument type - not an unsigned integer");
    c = 1;
    break;

  case C_BAD_ARGUMENT_TYPE_NO_FLONUM_ERROR:
    msg = C_text("bad argument type - not a flonum");
    c = 1;
    break;

  case C_BAD_ARGUMENT_TYPE_BAD_BASE_ERROR:
    msg = C_text("bad argument type - invalid base");
    c = 1;
    break;

  default:
    fprintf(stderr, "Unknown error");
    abort();
  }
  
  if(!C_immediatep(err)) {
    C_save(C_fix(code));
    
    C_save(C_intern2(&a, loc));
    
    va_start(v, loc);
    i = c;

    while(i--)
      C_save(va_arg(v, C_word));

    va_end(v);
    /* No continuation is passed: '##sys#error-hook' may not return: */
    C_do_apply(c + 2, C_block_item(err, 0), C_SCHEME_UNDEFINED); 
  } else {
    fprintf(stderr, "No error hook!");
    abort();
  }
}

void C_not_an_integer_error(char *loc, C_word x)
{
  barf(C_BAD_ARGUMENT_TYPE_NO_INTEGER_ERROR, loc, x);
}

/* Never use extended number hook procedure names longer than this! */
/* Current longest name: numbers#@extended-quotient&remainder */
#define MAX_EXTNUM_HOOK_NAME 64

/* This exists so that we don't have to create any extra closures */
static void try_extended_number(char *ext_proc_name, C_word c, C_word k, ...)
{
  static C_word ab[C_SIZEOF_STRING(MAX_EXTNUM_HOOK_NAME)];
  int i;
  va_list v;
  C_word ext_proc_sym, ext_proc = C_SCHEME_FALSE, *a = ab;

  ext_proc_sym = C_lookup_symbol(C_intern2(&a, ext_proc_name));

  if(!C_immediatep(ext_proc_sym))
    ext_proc = C_block_item(ext_proc_sym, 0);

  if (!C_immediatep(ext_proc) && C_closurep(ext_proc)) {
    va_start(v, k);
    i = c - 1;

    while(i--)
      C_save(va_arg(v, C_word));

    va_end(v);
    C_do_apply(c - 1, ext_proc, k);
  } else {
    /* TODO: Convert to barf(), add new error code */
    fprintf(stderr, "No extended number hook for %s!\n", ext_proc_name);
    abort();
  }
}

static C_word
init_tags(___scheme_value tagvec)
{
  tags = CHICKEN_new_gc_root();
  CHICKEN_gc_root_set(tags, tagvec);
  return C_SCHEME_UNDEFINED;
}

#define ratnum_type_tag C_block_item(CHICKEN_gc_root_ref(tags), RAT_TAG)
#define compnum_type_tag C_block_item(CHICKEN_gc_root_ref(tags), COMP_TAG)

C_inline C_word basic_eqvp(C_word x, C_word y)
{
  return (x == y ||

	  (!C_immediatep(x) && !C_immediatep(y) &&
	   C_block_header(x) == C_block_header(y) &&
	   
	   ((C_block_header(x) == C_FLONUM_TAG &&
	     C_flonum_magnitude(x) == C_flonum_magnitude(y)) ||
	    
	    (C_IS_BIGNUM_TYPE(x) && C_u_i_bignum_cmp(x, y) == C_fix(0)))));
}

/* TODO: Rename to C_i_eqvp */
C_regparm C_word C_fcall
C_i_numbers_eqvp(C_word x, C_word y)
{
  return
    C_mk_bool(basic_eqvp(x, y) ||
              (!C_immediatep(x) && !C_immediatep(y) &&
	       (C_block_header(x) == C_block_header(y) &&
	        C_header_bits(x) == C_STRUCTURE_TYPE &&
                C_block_item(x, 0) == C_block_item(y, 0) &&
                (C_block_item(x, 0) == ratnum_type_tag ||
                 C_block_item(x, 0) == compnum_type_tag) &&
                basic_eqvp(C_block_item(x, 1), C_block_item(y, 1)) &&
                basic_eqvp(C_block_item(x, 2), C_block_item(y, 2)))));
}

C_regparm C_word C_fcall C_i_nanp(C_word x)
{
  if (x & C_FIXNUM_BIT) {
    return C_SCHEME_FALSE;
  } else if (C_immediatep(x)) {
    barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "nan?", x);
  } else if (C_block_header(x) == C_FLONUM_TAG) {
    return C_u_i_flonum_nanp(x);
  } else if (C_IS_BIGNUM_TYPE(x)) {
    return C_SCHEME_FALSE;
  } else if (C_header_bits(x) == C_STRUCTURE_TYPE) {
    /* To make this inlineable we don't call try_extended_number */
    if (C_block_item(x, 0) == ratnum_type_tag)
      return C_SCHEME_FALSE;
    else if (C_block_item(x, 0) == compnum_type_tag)
      return C_mk_bool(C_truep(C_i_nanp(C_block_item(x, 1))) ||
		       C_truep(C_i_nanp(C_block_item(x, 2))));
    else
      barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "nan?", x);
  } else {
    barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "nan?", x);
  }
}

/* TODO: Rename to C_i_finitep */
C_regparm C_word C_fcall C_i_numbers_finitep(C_word x)
{
  if (x & C_FIXNUM_BIT) {
    return C_SCHEME_TRUE;
  } else if (C_immediatep(x)) {
    barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "finite?", x);
  } else if (C_block_header(x) == C_FLONUM_TAG) {
    return C_u_i_flonum_finitep(x);
  } else if (C_IS_BIGNUM_TYPE(x)) {
    return C_SCHEME_TRUE;
  } else if (C_header_bits(x) == C_STRUCTURE_TYPE) {
    /* To make this inlineable we don't use try_extended_number */
    if (C_block_item(x, 0) == ratnum_type_tag)
      return C_SCHEME_TRUE;
    else if (C_block_item(x, 0) == compnum_type_tag)
      return C_and(C_i_numbers_finitep(C_block_item(x, 1)),
		   C_i_numbers_finitep(C_block_item(x, 2)));
    else
      barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "finite?", x);
  } else {
    barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "finite?", x);
  }
}

/* TODO: Rename to C_i_infinitep */
C_regparm C_word C_fcall C_i_numbers_infinitep(C_word x)
{
  if (x & C_FIXNUM_BIT) {
    return C_SCHEME_FALSE;
  } else if (C_immediatep(x)) {
    barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "infinite?", x);
  } else if (C_block_header(x) == C_FLONUM_TAG) {
    return C_u_i_flonum_infinitep(x);
  } else if (C_IS_BIGNUM_TYPE(x)) {
    return C_SCHEME_FALSE;
  } else if (C_header_bits(x) == C_STRUCTURE_TYPE) {
    /* To make this inlineable we don't use try_extended_number */
    if (C_block_item(x, 0) == ratnum_type_tag)
      return C_SCHEME_FALSE;
    else if (C_block_item(x, 0) == compnum_type_tag)
      return C_mk_bool(C_truep(C_i_numbers_infinitep(C_block_item(x, 1))) ||
                       C_truep(C_i_numbers_infinitep(C_block_item(x, 2))));
    else
      barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "infinite?", x);
  } else {
    barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "infinite?", x);
  }
}

/* TODO: Rename to C_i_zerop */
C_regparm C_word C_fcall C_i_numbers_zerop(C_word x)
{
  if (x & C_FIXNUM_BIT) {
    return C_mk_bool(x == C_fix(0));
  } else if (C_immediatep(x)) {
    barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "zero?", x);
  } else if (C_block_header(x) == C_FLONUM_TAG) {
    return C_mk_bool(C_flonum_magnitude(x) == 0.0);
  } else if (C_IS_BIGNUM_TYPE(x) ||
	     (C_header_bits(x) == C_STRUCTURE_TYPE &&
	      (C_block_item(x, 0) == ratnum_type_tag ||
	       C_block_item(x, 0) == compnum_type_tag))) {
    return C_SCHEME_FALSE;
  } else {
    barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "zero?", x);
  }
}

/* Copy all the digits from source to target, obliterating what was
 * there.  If target is larger than source, the most significant
 * digits will remain untouched.
 */
C_inline void bignum_digits_destructive_copy(C_word target, C_word source)
{
  C_memcpy(C_bignum_digits(target), C_bignum_digits(source),
           /* TODO: This is currently in bytes.  If we change the
            * representation that needs to change!
            * We subtract the size of the header, too.
            */
           C_header_size(C_internal_bignum(source))-C_wordstobytes(1));
}

void C_ccall
C_2_basic_plus(C_word c, C_word self, C_word k, C_word x, C_word y)
{
  C_word ab[nmax(C_SIZEOF_FIX_BIGNUM, C_SIZEOF_FLONUM*2)], *a = ab;

  if (x & C_FIXNUM_BIT) {
    if (y & C_FIXNUM_BIT) {
      C_kontinue(k, C_a_u_i_2_fixnum_plus(&a, 2, x, y));
    } else if (C_immediatep(y)) {
      barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "+", y);
    } else if (C_block_header(y) == C_FLONUM_TAG) {
      C_kontinue(k, C_flonum(&a, (double)C_unfix(x) + C_flonum_magnitude(y)));
    } else if (C_IS_BIGNUM_TYPE(y)) {
      C_u_2_bignum_plus(4, (C_word)NULL, k, C_a_u_i_fix_to_big(&a, x), y);
    } else {
      try_extended_number("numbers#@extended-2-plus", 3, k, x, y);
    }
  } else if (C_immediatep(x)) {
    barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "+", x);
  } else if (C_block_header(x) == C_FLONUM_TAG) {
    if (y & C_FIXNUM_BIT) {
      C_kontinue(k, C_flonum(&a, C_flonum_magnitude(x) + (double)C_unfix(y)));
    } else if (C_immediatep(y)) {
      barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "+", y);
    } else if (C_block_header(y) == C_FLONUM_TAG) {
      C_kontinue(k, C_a_i_flonum_plus(&a, 2, x, y));
    } else if (C_IS_BIGNUM_TYPE(y)) {
      C_kontinue(k, C_a_i_flonum_plus(&a, 2, x, C_a_u_i_big_to_flo(&a, 1, y)));
    } else {
      try_extended_number("numbers#@extended-2-plus", 3, k, x, y);
    }
  } else if (C_IS_BIGNUM_TYPE(x)) {
    if (y & C_FIXNUM_BIT) {
      C_u_2_bignum_plus(4, (C_word)NULL, k, x, C_a_u_i_fix_to_big(&a, y));
    } else if (C_immediatep(y)) {
      barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "+", y);
    } else if (C_block_header(y) == C_FLONUM_TAG) {
      C_kontinue(k, C_a_i_flonum_plus(&a, 2, C_a_u_i_big_to_flo(&a, 1, x), y));
    } else if (C_IS_BIGNUM_TYPE(y)) {
      C_u_2_bignum_plus(4, (C_word)NULL, k, x, y);
    } else {
      try_extended_number("numbers#@extended-2-plus", 3, k, x, y);
    }
  } else {
    try_extended_number("numbers#@extended-2-plus", 3, k, x, y);
  }
}

void C_ccall
C_u_2_integer_plus(C_word c, C_word self, C_word k, C_word x, C_word y)
{
  C_word ab[C_SIZEOF_FIX_BIGNUM * 2], *a = ab;

  if (x & C_FIXNUM_BIT && y & C_FIXNUM_BIT)
    C_kontinue(k, C_a_u_i_2_fixnum_plus(&a, 2, x, y));

  if (x & C_FIXNUM_BIT)
    x = C_a_u_i_fix_to_big(&a, x);
  if (y & C_FIXNUM_BIT)
    y = C_a_u_i_fix_to_big(&a, y);

  C_u_2_bignum_plus(4, (C_word)NULL, k, x, y);
}

/* Needs C_SIZEOF_FIX_BIGNUM */
C_regparm C_word C_fcall
C_a_u_i_2_fixnum_plus(C_word **ptr, C_word n, C_word x, C_word y)
{
  /* Exceptional situation: this will cause a real overflow */
  if (x == C_fix(C_MOST_NEGATIVE_FIXNUM) && y == C_fix(C_MOST_NEGATIVE_FIXNUM)) {
    return C_bignum2(ptr, 1, 0, 2);
  } else {
    C_word z = C_unfix(x) + C_unfix(y);

    if(!C_fitsinfixnump(z)) {
      /* TODO: function/macro returning either fixnum or bignum from a C int */
      /* This should help with the C API/FFI too. */
      return C_bignum2(ptr, (z < 0), labs(z) & (C_uword)C_BIGNUM_DIGIT_MASK, 1);
    } else {
      return C_fix(z);
    }
  }
}

void C_ccall
C_u_2_bignum_plus(C_word c, C_word self, C_word k, C_word x, C_word y)
{
  if (C_bignum_negativep(x)) {
    if (C_bignum_negativep(y)) {
      bignum_plus_unsigned(k, x, y, C_SCHEME_TRUE);
    } else {
      bignum_minus_unsigned(k, y, x);
    }
  } else {
    if (C_bignum_negativep(y)) {
      bignum_minus_unsigned(k, x, y);
    } else {
      bignum_plus_unsigned(k, x, y, C_SCHEME_FALSE);
    }
  }
}

void C_ccall
C_2_basic_minus(C_word c, C_word self, C_word k, C_word x, C_word y)
{
  C_word ab[nmax(C_SIZEOF_FIX_BIGNUM, C_SIZEOF_FLONUM*2)], *a = ab;

  if (x & C_FIXNUM_BIT) {
    if (y & C_FIXNUM_BIT) {
      C_kontinue(k, C_a_u_i_2_fixnum_minus(&a, 2, x, y));
    } else if (C_immediatep(y)) {
      barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "-", y);
    } else if (C_block_header(y) == C_FLONUM_TAG) {
      C_kontinue(k, C_flonum(&a, (double)C_unfix(x) - C_flonum_magnitude(y)));
    } else if (C_IS_BIGNUM_TYPE(y)) {
      C_u_2_bignum_minus(4, (C_word)NULL, k, C_a_u_i_fix_to_big(&a, x), y);
    } else {
      try_extended_number("numbers#@extended-2-minus", 3, k, x, y);
    }
  } else if (C_immediatep(x)) {
    barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "-", x);
  } else if (C_block_header(x) == C_FLONUM_TAG) {
    if (y & C_FIXNUM_BIT) {
      C_kontinue(k, C_flonum(&a, C_flonum_magnitude(x) - (double)C_unfix(y)));
    } else if (C_immediatep(y)) {
      barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "-", y);
    } else if (C_block_header(y) == C_FLONUM_TAG) {
      C_kontinue(k, C_a_i_flonum_difference(&a, 2, x, y)); /* XXX NAMING! */
    } else if (C_IS_BIGNUM_TYPE(y)) {
      C_kontinue(k, C_a_i_flonum_difference(&a, 2, x, C_a_u_i_big_to_flo(&a, 1, y)));
    } else {
      try_extended_number("numbers#@extended-2-minus", 3, k, x, y);
    }
  } else if (C_IS_BIGNUM_TYPE(x)) {
    if (y & C_FIXNUM_BIT) {
      C_u_2_bignum_minus(4, (C_word)NULL, k, x, C_a_u_i_fix_to_big(&a, y));
    } else if (C_immediatep(y)) {
      barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "-", y);
    } else if (C_block_header(y) == C_FLONUM_TAG) {
      C_kontinue(k, C_a_i_flonum_difference(&a, 2, C_a_u_i_big_to_flo(&a, 1, x), y));
    } else if (C_IS_BIGNUM_TYPE(y)) {
      C_u_2_bignum_minus(4, (C_word)NULL, k, x, y);
    } else {
      try_extended_number("numbers#@extended-2-minus", 3, k, x, y);
    }
  } else {
    try_extended_number("numbers#@extended-2-minus", 3, k, x, y);
  }
}

void C_ccall
C_u_2_integer_minus(C_word c, C_word self, C_word k, C_word x, C_word y)
{
  C_word ab[C_SIZEOF_FIX_BIGNUM * 2], *a = ab;

  if (x & C_FIXNUM_BIT && y & C_FIXNUM_BIT)
    C_kontinue(k, C_a_u_i_2_fixnum_minus(&a, 2, x, y));

  if (x & C_FIXNUM_BIT)
    x = C_a_u_i_fix_to_big(&a, x);
  if (y & C_FIXNUM_BIT)
    y = C_a_u_i_fix_to_big(&a, y);

  C_u_2_bignum_minus(4, (C_word)NULL, k, x, y);
}

/* Needs C_SIZEOF_FIX_BIGNUM */
C_regparm C_word C_fcall
C_a_u_i_2_fixnum_minus(C_word **ptr, C_word n, C_word x, C_word y)
{
  C_word z = C_unfix(x) - C_unfix(y);

  if(!C_fitsinfixnump(z)) {
    /* TODO: function/macro returning either fixnum or bignum from a C int */
    /* This should help with the C API/FFI too. */
    return C_bignum2(ptr, (z < 0), labs(z) & (C_uword)C_BIGNUM_DIGIT_MASK, 1);
  } else {
    return C_fix(z);
  }
}

void C_ccall
C_u_2_bignum_minus(C_word c, C_word self, C_word k, C_word x, C_word y)
{
  if (C_bignum_negativep(x)) {
    if (C_bignum_negativep(y)) {
      bignum_minus_unsigned(k, y, x);
    } else {
      bignum_plus_unsigned(k, x, y, C_SCHEME_TRUE);
    }
  } else {
    if (C_bignum_negativep(y)) {
      bignum_plus_unsigned(k, x, y, C_SCHEME_FALSE);
    } else {
      bignum_minus_unsigned(k, x, y);
    }
  }
}

static void
bignum_plus_unsigned(C_word k, C_word x, C_word y, C_word negp)
{
  C_word kab[C_SIZEOF_CLOSURE(4)], *ka = kab, k2, size;

  if (C_bignum_size(y) > C_bignum_size(x)) {  /* Ensure size(y) <= size(x) */
    C_word z = x;
    x = y;
    y = z;
  }

  k2 = C_closure(&ka, 4, (C_word)bignum_plus_unsigned_2, k, x, y);
  
  size = C_fix(C_bignum_size(x) + 1); /* One more digit, for possible carry. */
  C_allocate_bignum(5, (C_word)NULL, k2, size, negp, C_SCHEME_FALSE);
}

static void
bignum_plus_unsigned_2(C_word c, C_word self, C_word result)
{
  C_word k = C_block_item(self, 1),
         x = C_block_item(self, 2),
         y = C_block_item(self, 3);
  C_uword *scan_y = C_bignum_digits(y),
          *end_y = scan_y + C_bignum_size(y),
          *scan_r = C_bignum_digits(result),
          *end_r = scan_r + C_bignum_size(result),
          sum;
  int carry = 0;

  /* Copy x into r so we can operate on two pointers, which is faster
   * than three, and we can stop earlier after adding y.  It's slower
   * if x and y have equal length.  On average it's slightly faster.
   */
  bignum_digits_destructive_copy(result, x);
  *(end_r-1) = 0; /* Ensure most significant digit is initialised */

  /* Move over x and y simultaneously, destructively adding digits w/ carry. */
  while (scan_y < end_y) {
    sum = *scan_r + (*scan_y++) + carry;
    carry = sum >> C_BIGNUM_DIGIT_LENGTH;
    (*scan_r++) = sum & C_BIGNUM_DIGIT_MASK;
  }
  
  /* The end of y, the smaller number.  Propagate carry into the rest of x. */
  while (carry) {
    sum = (*scan_r) + 1;
    carry = sum >> C_BIGNUM_DIGIT_LENGTH;
    (*scan_r++) = sum & C_BIGNUM_DIGIT_MASK;
  }
  assert(scan_r <= end_r);

  C_kontinue(k, C_bignum_simplify(result));
}

static int
bignum_cmp_unsigned(C_word x, C_word y)
{
  C_word xlen = C_bignum_size(x), ylen = C_bignum_size(y);

  if (xlen < ylen) {
    return -1;
  } else if (xlen > ylen) {
    return 1;
  } else if (x == y) {
    return 0;
  } else {
    C_uword *startx = C_bignum_digits(x),
            *scanx = startx + xlen,
            *scany = C_bignum_digits(y) + ylen;

    while (startx < scanx) {
      C_uword xdigit = (*--scanx), ydigit = (*--scany);
      if (xdigit < ydigit)
        return -1;
      if (xdigit > ydigit)
        return 1;
    }
    return 0;
  }
}

static void
bignum_minus_unsigned(C_word k, C_word x, C_word y)
{
  C_word kab[C_SIZEOF_CLOSURE(4)], *ka = kab, k2, size, negp;

  switch(bignum_cmp_unsigned(x, y)) {
  case 0:	      /* x = y, return 0 */
    C_kontinue(k, C_fix(0));
  case -1:	      /* abs(x) < abs(y), return -(abs(y) - abs(x)) */
    k2 = C_closure(&ka, 4, (C_word)bignum_minus_unsigned_2, k, y, x);
    
    size = C_fix(C_bignum_size(y)); /* Maximum size of result is length of y. */
    C_allocate_bignum(5, (C_word)NULL, k2, size, C_SCHEME_TRUE, C_SCHEME_FALSE);
  case 1:	      /* abs(x) > abs(y), return abs(x) - abs(y) */
  default:
    k2 = C_closure(&ka, 4, (C_word)bignum_minus_unsigned_2, k, x, y);
    
    size = C_fix(C_bignum_size(x)); /* Maximum size of result is length of x. */
    C_allocate_bignum(5, (C_word)NULL, k2, size, C_SCHEME_FALSE, C_SCHEME_FALSE);
    break;
  }
}

static void
bignum_minus_unsigned_2(C_word c, C_word self, C_word result)
{
  C_word k = C_block_item(self, 1),
         x = C_block_item(self, 2),
         y = C_block_item(self, 3),
         difference;
  C_uword *scan_r = C_bignum_digits(result),
          *end_r = scan_r + C_bignum_size(result),
          *scan_y = C_bignum_digits(y),
          *end_y = scan_y + C_bignum_size(y);
  int borrow = 0;

  bignum_digits_destructive_copy(result, x); /* See bignum_plus_unsigned_2 */

  /* Destructively subtract y's digits w/ borrow from and back into r. */
  while (scan_y < end_y) {
    difference = *scan_r - (*scan_y++) - borrow;
    borrow = difference < 0;
    (*scan_r++) = difference + ((C_uword)borrow << C_BIGNUM_DIGIT_LENGTH);
  }

  /* The end of y, the smaller number.  Propagate borrow into the rest of x. */
  while (borrow) {
    difference = *scan_r - borrow;
    borrow = difference < 0;
    (*scan_r++) = difference + ((C_uword)borrow << C_BIGNUM_DIGIT_LENGTH);
  }

  assert(scan_r <= end_r);

  C_kontinue(k, C_bignum_simplify(result));
}

C_word C_ccall
C_u_i_2_fixnum_gcd(C_word x, C_word y)
{
   C_word r;
   
   x = C_unfix(x);
   y = C_unfix(y);
   
   if (x < 0) x = -x;
   if (y < 0) y = -y;
   
   while(y != 0) {
     r = x % y;
     x = y;
     y = r;
   }
   return C_fix(x);
}

C_word C_ccall
C_a_u_i_2_flonum_gcd(C_word **p, C_word n, C_word x, C_word y)
{
   double xub, yub, r;

   if (!C_truep(C_u_i_fpintegerp(x)))
     barf(C_BAD_ARGUMENT_TYPE_NO_INTEGER_ERROR, "gcd", x);
   if (!C_truep(C_u_i_fpintegerp(y)))
     barf(C_BAD_ARGUMENT_TYPE_NO_INTEGER_ERROR, "gcd", y);

   xub = C_flonum_magnitude(x);
   yub = C_flonum_magnitude(y);

   if (xub < 0.0) xub = -xub;
   if (yub < 0.0) yub = -yub;
   
   while(yub != 0.0) {
     r = fmod(xub, yub);
     xub = yub;
     yub = r;
   }
   return C_flonum(p, xub);
}

void C_ccall
C_basic_abs(C_word c, C_word self, C_word k, C_word x)
{
  C_word ab[nmax(C_SIZEOF_FIX_BIGNUM, C_SIZEOF_FLONUM)], *a = ab;

  if (x & C_FIXNUM_BIT)
    C_kontinue(k, C_a_u_i_fixnum_abs(&a, 1, x));
  else if (C_immediatep(x))
    barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "abs", x);
  else if (C_block_header(x) == C_FLONUM_TAG)
    C_kontinue(k, C_a_i_flonum_abs(&a, 1, x));
  else if (C_IS_BIGNUM_TYPE(x))
    C_u_bignum_abs(3, (C_word)NULL, k, x);
  else
    try_extended_number("numbers#@extended-abs", 2, k, x);
}

void C_ccall
C_u_integer_abs(C_word c, C_word self, C_word k, C_word x)
{
  C_word ab[C_SIZEOF_FIX_BIGNUM], *a = ab;

  if (x & C_FIXNUM_BIT)
    C_kontinue(k, C_a_u_i_fixnum_abs(&a, 1, x));
  else
    C_u_bignum_abs(3, (C_word)NULL, k, x);
}

void C_ccall
C_u_bignum_abs(C_word c, C_word self, C_word k, C_word x)
{
  if (C_bignum_negativep(x))
    C_u_bignum_negate(3, (C_word)NULL, k, x);
  else
    C_kontinue(k, x);
}

/* TODO: This could be made allocating inline: only compnums need
 * allocation, and they only allocate new compnums (fixed size).
 */
void C_ccall
C_basic_signum(C_word c, C_word self, C_word k, C_word x)
{
  C_word ab[C_SIZEOF_FLONUM], *a = ab;

  if (x & C_FIXNUM_BIT)
    C_kontinue(k, C_u_i_fixnum_signum(x));
  else if (C_immediatep(x))
    barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "signum", x);
  else if (C_block_header(x) == C_FLONUM_TAG)
    C_kontinue(k, C_a_u_i_flonum_signum(&a, 1, x));
  else if (C_IS_BIGNUM_TYPE(x))
    C_kontinue(k, C_u_i_bignum_signum(x));
  else
    try_extended_number("numbers#@extended-signum", 2, k, x);
}

C_regparm C_word C_fcall C_u_i_integer_signum(C_word x)
{
  if (x & C_FIXNUM_BIT) return C_u_i_fixnum_signum(x);
  else return C_u_i_bignum_signum(x);
}

C_regparm C_word C_fcall C_i_basic_evenp(C_word x)
{
  double val, dummy;
  if(x & C_FIXNUM_BIT) {
    return C_mk_nbool(x & 0x02);
  } else if(C_immediatep(x)) {
    barf(C_BAD_ARGUMENT_TYPE_NO_INTEGER_ERROR, "even?", x);
  } else if (C_block_header(x) == C_FLONUM_TAG) {
    val = C_flonum_magnitude(x);
    if(C_isnan(val) || C_isinf(val) || C_modf(val, &dummy) != 0.0)
      barf(C_BAD_ARGUMENT_TYPE_NO_INTEGER_ERROR, "even?", x);
    else
      return C_mk_bool(fmod(val, 2.0) == 0.0);
  } else if (C_IS_BIGNUM_TYPE(x)) {
    return C_u_i_bignum_evenp(x);
  } else { /* No need to try extended number */
    barf(C_BAD_ARGUMENT_TYPE_NO_INTEGER_ERROR, "even?", x);
  }
}

C_regparm C_word C_fcall C_u_i_integer_evenp(C_word x)
{
  if(x & C_FIXNUM_BIT) return C_mk_nbool(x & 0x02);
  return C_u_i_bignum_evenp(x);
}

C_regparm C_word C_fcall C_i_basic_oddp(C_word x)
{
  double val, dummy;
  if(x & C_FIXNUM_BIT) {
    return C_mk_bool(x & 0x02);
  } else if(C_immediatep(x)) {
    barf(C_BAD_ARGUMENT_TYPE_NO_INTEGER_ERROR, "odd?", x);
  } else if(C_block_header(x) == C_FLONUM_TAG) {
    val = C_flonum_magnitude(x);
    if(C_isnan(val) || C_isinf(val) || C_modf(val, &dummy) != 0.0)
      barf(C_BAD_ARGUMENT_TYPE_NO_INTEGER_ERROR, "odd?", x);
    else
      return C_mk_bool(fmod(val, 2.0) != 0.0);
  } else if (C_IS_BIGNUM_TYPE(x)) {
    return C_u_i_bignum_oddp(x);
  } else {
    barf(C_BAD_ARGUMENT_TYPE_NO_INTEGER_ERROR, "odd?", x);
  }
}

C_regparm C_word C_fcall C_u_i_integer_oddp(C_word x)
{
  if(x & C_FIXNUM_BIT) return C_mk_bool(x & 0x02);
  return C_u_i_bignum_oddp(x);
}

void C_ccall
C_basic_negate(C_word c, C_word self, C_word k, C_word x)
{
  C_word ab[nmax(C_SIZEOF_FIX_BIGNUM, C_SIZEOF_FLONUM)], *a = ab;

  if (x & C_FIXNUM_BIT)
    C_kontinue(k, C_a_u_i_fixnum_negate(&a, 1, x));
  else if (C_immediatep(x))
    barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "-", x);
  else if (C_block_header(x) == C_FLONUM_TAG)
    C_kontinue(k, C_a_i_flonum_negate(&a, 1, x));
  else if (C_IS_BIGNUM_TYPE(x))
    C_u_bignum_negate(3, (C_word)NULL, k, x);
  else
    try_extended_number("numbers#@extended-negate", 2, k, x);
}

void C_ccall
C_u_integer_negate(C_word c, C_word self, C_word k, C_word x)
{
  C_word ab[C_SIZEOF_FIX_BIGNUM], *a = ab;

  if (x & C_FIXNUM_BIT)
    C_kontinue(k, C_a_u_i_fixnum_negate(&a, 1, x));
  else
    C_u_bignum_negate(3, (C_word)NULL, k, x);
}

C_regparm C_word C_fcall
C_a_u_i_fixnum_negate(C_word **ptr, C_word n, C_word x)
{
  /* Exceptional situation: this will cause an overflow to itself */
  if (x == C_fix(C_MOST_NEGATIVE_FIXNUM)) /* C_fitsinfixnump(x) */
    return C_bignum2(ptr, 0, 0, 1);
  else
    return C_fix(-C_unfix(x));
}

void C_ccall
C_u_bignum_negate(C_word c, C_word self, C_word k, C_word x)
{
  if (C_bignum_negated_fitsinfixnump(x)) {
    C_kontinue(k, C_fix(C_MOST_NEGATIVE_FIXNUM));
  } else {
    C_word kab[C_SIZEOF_CLOSURE(3)], *ka = kab, k2,
	   negp = C_mk_nbool(C_bignum_negativep(x)),
	   size = C_fix(C_bignum_size(x));
    k2 = C_closure(&ka, 3, (C_word)bignum_negate_2, k, x);
    C_allocate_bignum(5, (C_word)NULL, k2, size, negp, C_SCHEME_FALSE);
  }
}

static void
bignum_negate_2(C_word c, C_word self, C_word new_big)
{
  C_word k = C_block_item(self, 1),
	 old_big = C_block_item(self, 2);
  bignum_digits_destructive_copy(new_big, old_big);
  C_kontinue(k, C_bignum_simplify(new_big));
}


/* TODO: Once these are inlineable, rewrite them in terms of a
 * common C_2_basic_cmp which returns -1, 0, or 1.  This should
 * reduce the amount of needed code quite a bit, and would allow
 * easier implementation of lessp, greaterp, and also the set
 * {greater_or_|less_or_}?equalp, as inline loops without any
 * conversion to a vararg list in Scheme!
 */
void C_ccall
C_2_basic_equalp(C_word c, C_word self, C_word k, C_word x, C_word y)
{
  C_word ab[C_SIZEOF_FIX_BIGNUM], *a = ab, res;

  if (x & C_FIXNUM_BIT) {
    if (y & C_FIXNUM_BIT) {
      C_kontinue(k, C_mk_bool(x == y));
    } else if (C_immediatep(y)) {
      barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "=", y);
    } else if (C_block_header(y) == C_FLONUM_TAG) {
      C_kontinue(k, C_mk_bool(int_flo_cmp(x, y) == C_fix(0)));
    } else if (C_IS_BIGNUM_TYPE(y)) {
      C_kontinue(k, C_SCHEME_FALSE);
    } else {
      try_extended_number("numbers#@extended-2-=", 3, k, x, y);
    }
  } else if (C_immediatep(x)) {
    barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "=", x);
  } else if (C_block_header(x) == C_FLONUM_TAG) {
    if (y & C_FIXNUM_BIT) {
      C_kontinue(k, C_mk_bool(flo_int_cmp(x, y) == C_fix(0)));
    } else if (C_immediatep(y)) {
      barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "=", y);
    } else if (C_block_header(y) == C_FLONUM_TAG) {
      C_kontinue(k, C_flonum_equalp(x, y));
    } else if (C_IS_BIGNUM_TYPE(y)) {
      C_kontinue(k, C_mk_bool(flo_int_cmp(x, y) == C_fix(0)));
    } else {
      try_extended_number("numbers#@extended-2-=", 3, k, x, y);
    }
  } else if (C_IS_BIGNUM_TYPE(x)) {
    if (y & C_FIXNUM_BIT) {
      C_kontinue(k, C_SCHEME_FALSE);
    } else if (C_immediatep(y)) {
      barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "=", y);
    } else if (C_block_header(y) == C_FLONUM_TAG) {
      C_kontinue(k, C_mk_bool(int_flo_cmp(x, y) == C_fix(0)));
    } else if (C_IS_BIGNUM_TYPE(y)) {
      C_kontinue(k, C_mk_bool(C_u_i_bignum_cmp(x, y) == C_fix(0)));
    } else {
      try_extended_number("numbers#@extended-2-=", 3, k, x, y);
    }
  } else {
    try_extended_number("numbers#@extended-2-=", 3, k, x, y);
  }
}

C_word C_ccall
C_u_i_2_integer_equalp(C_word x, C_word y)
{
  if (x & C_FIXNUM_BIT)
    return C_mk_bool(x == y);
  else if (y & C_FIXNUM_BIT)
    return C_SCHEME_FALSE;
  else
    return C_mk_bool(C_u_i_bignum_cmp(x, y) == C_fix(0));
}

void C_ccall
C_2_basic_lessp(C_word c, C_word self, C_word k, C_word loc, C_word x, C_word y)
{
  C_word ab[C_SIZEOF_FIX_BIGNUM], *a = ab;

  if (x & C_FIXNUM_BIT) {
    if (y & C_FIXNUM_BIT) {
      C_kontinue(k, C_mk_bool(C_unfix(x) < C_unfix(y)));
    } else if (C_immediatep(y)) {
      barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, C_strloc(loc), y);
    } else if (C_block_header(y) == C_FLONUM_TAG) {
      C_kontinue(k, C_mk_bool(int_flo_cmp(x, y) == C_fix(-1)));
    } else if (C_IS_BIGNUM_TYPE(y)) {
      /* A fixnum can only be smaller than a positive bignum */
      C_kontinue(k, C_mk_nbool(C_bignum_negativep(y)));
    } else {
      try_extended_number("numbers#@extended-2-<", 4, k, loc, x, y);
    }
  } else if (C_immediatep(x)) {
    barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, C_strloc(loc), x);
  } else if (C_block_header(x) == C_FLONUM_TAG) {
    if (y & C_FIXNUM_BIT) {
      C_kontinue(k, C_mk_bool(flo_int_cmp(x, y) == C_fix(-1)));
    } else if (C_immediatep(y)) {
       barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, C_strloc(loc), y);
    } else if (C_block_header(y) == C_FLONUM_TAG) {
      C_kontinue(k, C_flonum_lessp(x, y));
    } else if (C_IS_BIGNUM_TYPE(y)) {
      C_kontinue(k, C_mk_bool(flo_int_cmp(x, y) == C_fix(-1)));
    } else {
      try_extended_number("numbers#@extended-2-<", 4, k, loc, x, y);
    }
  } else if (C_IS_BIGNUM_TYPE(x)) {
    if (y & C_FIXNUM_BIT) {
      /* Only a negative bignum is smaller than any fixnum */
      C_kontinue(k, C_mk_bool(C_bignum_negativep(x)));
    } else if (C_immediatep(y)) {
       barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, C_strloc(loc), y);
    } else if (C_block_header(y) == C_FLONUM_TAG) {
      C_kontinue(k, C_mk_bool(int_flo_cmp(x, y) == C_fix(-1)));
    } else if (C_IS_BIGNUM_TYPE(y)) {
      C_kontinue(k, C_mk_bool(C_u_i_bignum_cmp(x, y) == C_fix(-1)));
    } else {
      try_extended_number("numbers#@extended-2-<", 4, k, loc, x, y);
    }
  } else {
    try_extended_number("numbers#@extended-2-<", 4, k, loc, x, y);
  }
}

C_word C_ccall
C_u_i_2_integer_lessp(C_word x, C_word y)
{
  if (x & C_FIXNUM_BIT) {
    if (y & C_FIXNUM_BIT) {
      return C_mk_bool(C_unfix(x) < C_unfix(y));
    } else {
      return C_mk_nbool(C_bignum_negativep(y));
    }
  } else if (y & C_FIXNUM_BIT) {
    return C_mk_bool(C_bignum_negativep(x));
  } else {
    return C_mk_bool(C_u_i_bignum_cmp(x, y) == C_fix(-1));
  }
}

void C_ccall
C_2_basic_greaterp(C_word c, C_word self, C_word k, C_word loc, C_word x, C_word y)
{
  C_word ab[C_SIZEOF_FIX_BIGNUM], *a = ab;

  if (x & C_FIXNUM_BIT) {
    if (y & C_FIXNUM_BIT) {
      C_kontinue(k, C_mk_bool(C_unfix(x) > C_unfix(y)));
    } else if (C_immediatep(y)) {
      barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, C_strloc(loc), y);
    } else if (C_block_header(y) == C_FLONUM_TAG) {
      C_kontinue(k, C_mk_bool(int_flo_cmp(x, y) == C_fix(1)));
    } else if (C_IS_BIGNUM_TYPE(y)) {
      /* A fixnum can only be larger than a negative bignum */
      C_kontinue(k, C_mk_bool(C_bignum_negativep(y)));
    } else {
      try_extended_number("numbers#@extended-2->", 4, k, loc, x, y);
    }
  } else if (C_immediatep(x)) {
    barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, C_strloc(loc), x);
  } else if (C_block_header(x) == C_FLONUM_TAG) {
    if (y & C_FIXNUM_BIT) {
      C_kontinue(k, C_mk_bool(flo_int_cmp(x, y) == C_fix(1)));
    } else if (C_immediatep(y)) {
      barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, C_strloc(loc), y);
    } else if (C_block_header(y) == C_FLONUM_TAG) {
      C_kontinue(k, C_flonum_greaterp(x, y));
    } else if (C_IS_BIGNUM_TYPE(y)) {
      C_kontinue(k, C_mk_bool(flo_int_cmp(x, y) == C_fix(1)));
    } else {
      try_extended_number("numbers#@extended-2->", 4, k, loc, x, y);
    }
  } else if (C_IS_BIGNUM_TYPE(x)) {
    if (y & C_FIXNUM_BIT) {
      /* Only a positive bignum is greater than any fixnum */
      C_kontinue(k, C_mk_nbool(C_bignum_negativep(x)));
    } else if (C_immediatep(y)) {
      barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, C_strloc(loc), y);
    } else if (C_block_header(y) == C_FLONUM_TAG) {
      C_kontinue(k, C_mk_bool(int_flo_cmp(x, y) == C_fix(1)));
    } else if (C_IS_BIGNUM_TYPE(y)) {
      C_kontinue(k, C_mk_bool(C_u_i_bignum_cmp(x, y) == C_fix(1)));
    } else {
      try_extended_number("numbers#@extended-2->", 4, k, loc, x, y);
    }
  } else {
      try_extended_number("numbers#@extended-2->", 4, k, loc, x, y);
  }
}

C_word C_ccall
C_u_i_2_integer_greaterp(C_word x, C_word y)
{
  if (x & C_FIXNUM_BIT) {
    if (y & C_FIXNUM_BIT) {
      return C_mk_bool(C_unfix(x) > C_unfix(y));
    } else {
      return C_mk_bool(C_bignum_negativep(y));
    }
  } else if (y & C_FIXNUM_BIT) {
    return C_mk_nbool(C_bignum_negativep(x));
  } else {
    return C_mk_bool(C_u_i_bignum_cmp(x, y) == C_fix(1));
  }
}

/* This is a bit weird: We have to compare flonums as bignums due to
 * precision loss on 64-bit platforms.  For simplicity, we convert
 * fixnums to bignums here.
 */
static C_word int_flo_cmp(C_word intnum, C_word flonum)
{
  C_word ab[C_SIZEOF_FIX_BIGNUM + C_SIZEOF_FLONUM], *a = ab, x, y, res;
  double i, f;

  f = C_flonum_magnitude(flonum);

  if (C_isnan(f)) {
    return C_SCHEME_FALSE; /* "mu" */
  } else if (C_isinf(f)) {
    return C_fix((f > 0.0) ? -1 : 1); /* x is smaller if f is +inf.0 */
  } else {
    f = modf(f, &i);

    x = (intnum & C_FIXNUM_BIT) ? C_a_u_i_fix_to_big(&a, intnum) : intnum;
    y = flo_to_tmp_bignum(C_flonum(&a, i));

    res = C_u_i_bignum_cmp(x, y);
    free_tmp_bignum(y);

    if (res == C_fix(0)) /* Use fraction to break tie. If f > 0, x is smaller */
      return C_fix((f > 0.0) ? -1 : ((f < 0.0) ? 1 : 0));
    else
      return res;
  }
}

/* For convenience (ie, to reduce the degree of mindfuck) */
static C_word flo_int_cmp(C_word flonum, C_word intnum)
{
  C_word res = int_flo_cmp(intnum, flonum);
  switch(res) {
  case C_fix(1): return C_fix(-1);
  case C_fix(-1): return C_fix(1);
  default: return res; /* Can be either C_fix(0) or C_SCHEME_FALSE(!) */
  }
}

C_word
C_u_i_bignum_cmp(C_word x, C_word y)
{
  if (C_bignum_negativep(x)) {
    if (C_bignum_negativep(y)) { /* Largest negative number is smallest */
      return C_fix(bignum_cmp_unsigned(y, x));
    } else {
      return C_fix(-1);
    }
  } else {
    if (C_bignum_negativep(y)) {
      return C_fix(1);
    } else {
      return C_fix(bignum_cmp_unsigned(x, y));
    }
  }
}

/* XXX TODO: Maybe pass true/false/bignum as initp, to allow copying data? */
void C_ccall
C_allocate_bignum(C_word c, C_word self, C_word k, C_word size, C_word negp, C_word initp)
{
  C_word kab[C_SIZEOF_CLOSURE(3)], *ka = kab, k2, init;
  k2 = C_closure(&ka, 3, (C_word)allocate_bignum_2, k, negp);

  init = C_and(initp, C_make_character('\0'));
  C_allocate_vector(6, (C_word)NULL, k2,
		    C_bytes(C_fixnum_plus(size, C_fix(1))), /* Add header */
                    /* Byte vec, initialization, align at 8 bytes */
                    C_SCHEME_TRUE, init, C_SCHEME_FALSE);
}

static void
allocate_bignum_2(C_word c, C_word self, C_word bigvec)
{
  C_word ab[C_SIZEOF_STRUCTURE(2)], *a = ab, bignum,
         k = C_block_item(self, 1),
         negp = C_truep(C_block_item(self, 2)),
	 size = C_bytestowords(C_header_size(bigvec))-1;

  C_word tagvec = CHICKEN_gc_root_ref(tags);

  C_set_block_item(bigvec, 0, negp);

  bignum = C_structure(&a, 2, C_block_item(tagvec, BIG_TAG), bigvec);
  C_kontinue(k, bignum);
}

static C_word
allocate_tmp_bignum(C_word size, C_word negp, C_word initp)
{
  C_word *mem = malloc(C_wordstobytes(C_SIZEOF_BIGNUM(C_unfix(size)))),
          bigvec = (C_word)(mem + C_SIZEOF_STRUCTURE(2));
  if (mem == NULL) abort();     /* TODO: panic */
  
  C_word tagvec = CHICKEN_gc_root_ref(tags);

  C_block_header_init(bigvec, (C_STRING_TYPE | C_wordstobytes(C_unfix(size)+1)));
  C_set_block_item(bigvec, 0, C_truep(negp));

  if (C_truep(initp))
    C_memset(C_data_pointer(bigvec)+1, 0, C_wordstobytes(C_unfix(size)));

  return C_structure(&mem, 2, C_block_item(tagvec, BIG_TAG), bigvec);
}

/* Simplification: scan trailing zeroes, then return a fixnum if the
 * value fits, or trim the bignum's length. */
C_word C_ccall
C_bignum_simplify(C_word big)
{
  C_uword *start = C_bignum_digits(big),
          *last_digit = start + C_bignum_size(big) - 1,
          *scan = last_digit;
  int length;

  while (scan >= start && *scan == 0)
    scan--;
  length = scan - start + 1;
  
  switch(length) {
  case 0:
    return C_fix(0);
  case 1:
    return C_fix(C_bignum_negativep(big) ? -*start : *start);
  case 2:
    if (C_bignum_negativep(big) && *scan == 1 && *start == 0)
      return C_fix(C_MOST_NEGATIVE_FIXNUM);
    /* FALLTHROUGH */
  default:
    if (scan < last_digit) /* Mutate vector size of internal bignum vector. */
      C_block_header(C_internal_bignum(big)) = (C_STRING_TYPE | C_wordstobytes(length+1));
    return big;
  }
}

static C_uword
bignum_digits_destructive_scale_up_with_carry(C_uword *start, C_uword *end, C_uword factor, C_uword carry)
{
  C_uword digit, product_hi, product_lo, *scan = start;

  assert(C_fitsinbignumhalfdigitp(carry));

  while (scan < end) {
    digit = (*scan);
    product_lo = factor * C_BIGNUM_DIGIT_LO_HALF(digit) + carry;
    product_hi = factor * C_BIGNUM_DIGIT_HI_HALF(digit) +
	    C_BIGNUM_DIGIT_HI_HALF(product_lo);
    (*scan++) = C_BIGNUM_DIGIT_COMBINE(C_BIGNUM_DIGIT_LO_HALF(product_hi),
				       C_BIGNUM_DIGIT_LO_HALF(product_lo));
    carry = C_BIGNUM_DIGIT_HI_HALF(product_hi);
  }
  return carry;
}

/* Given (denominator > 1), it is fairly easy to show that
   quotient_high fits a bignum halfdigit, after which it is easy to
   see that all digits fit a bignum full digit.
   
   This works because denominator is known to fit a halfdigit, which
   means that the remainder modulo denominator will also fit a halfdigit. */
static C_uword
bignum_digits_destructive_scale_down(C_uword *start, C_uword *end, C_uword denominator)
{
  C_uword quotient_high, numerator, remainder = 0, digit;

  assert((denominator > 1) && C_fitsinbignumhalfdigitp(denominator));

  end--;
  while (start <= end) {
    digit = *end;
    numerator = C_BIGNUM_DIGIT_COMBINE(remainder, C_BIGNUM_DIGIT_HI_HALF(digit));
    quotient_high = (numerator / denominator);
    numerator = C_BIGNUM_DIGIT_COMBINE(numerator % denominator,
                                         C_BIGNUM_DIGIT_LO_HALF(digit));
    (*end--) = C_BIGNUM_DIGIT_COMBINE(quotient_high, numerator / denominator);
    remainder = numerator % denominator;
  }
  return remainder;
}

static C_uword
bignum_digits_destructive_shift_right(C_uword *start, C_uword *end, int shift_right)
{
  C_uword shifted_out = 0, digit, carry = 0, mask = (1L << shift_right) - 1;
  int shift_left = C_BIGNUM_DIGIT_LENGTH - shift_right;

  assert(shift_right < C_BIGNUM_DIGIT_LENGTH);

  shifted_out = *start & mask;

  end--;
  while (start <= end) {
    digit = *end;
    (*end--) = ((digit >> shift_right) | carry);
    carry = ((digit & mask) << shift_left);
  }
  return shifted_out;
}

static C_uword
bignum_digits_destructive_shift_left(C_uword *start, C_uword *end, int shift_left)
{
  C_uword carry = 0, digit;
  int shift_right = C_BIGNUM_DIGIT_LENGTH - shift_left;

  assert(shift_left < C_BIGNUM_DIGIT_LENGTH);

  while (start < end) {
    digit = *start;
    (*start++) = ((digit << shift_left) & C_BIGNUM_DIGIT_MASK) | carry;
    carry = digit >> shift_right;
  }
  return carry;
}

void C_ccall
C_2_basic_times(C_word c, C_word self, C_word k, C_word x, C_word y)
{
  C_word ab[nmax(/*C_SIZEOF_FIX_BIGNUM, */ C_SIZEOF_FLONUM * 2,
                 C_SIZEOF_FIX_BIGNUM * 2 + C_SIZEOF_BIGNUM(4))],
         *a = ab;

  if (x & C_FIXNUM_BIT) {
    if (y & C_FIXNUM_BIT) {
      C_kontinue(k, C_a_u_i_2_fixnum_times(&a, 2, x, y));
    } else if (C_immediatep(y)) {
      barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "*", y);
    } else if (C_block_header(y) == C_FLONUM_TAG) {
      C_kontinue(k, C_flonum(&a, (double)C_unfix(x) * C_flonum_magnitude(y)));
    } else if (C_IS_BIGNUM_TYPE(y)) {
      C_u_2_integer_times(4, (C_word)NULL, k, x, y);
    } else {
      try_extended_number("numbers#@extended-2-times", 3, k, x, y);
    }
  } else if (C_immediatep(x)) {
    barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "*", x);
  } else if (C_block_header(x) == C_FLONUM_TAG) {
    if (y & C_FIXNUM_BIT) {
      C_kontinue(k, C_flonum(&a, C_flonum_magnitude(x) * (double)C_unfix(y)));
    } else if (C_immediatep(y)) {
      barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "*", y);
    } else if (C_block_header(y) == C_FLONUM_TAG) {
      C_kontinue(k, C_a_i_flonum_times(&a, 2, x, y));
    } else if (C_IS_BIGNUM_TYPE(y)) {
      C_kontinue(k, C_a_i_flonum_times(&a, 2, x, C_a_u_i_big_to_flo(&a, 1, y)));
    } else {
      try_extended_number("numbers#@extended-2-times", 3, k, x, y);
    }
  } else if (C_IS_BIGNUM_TYPE(x)) {
    if (y & C_FIXNUM_BIT) {
      C_u_2_integer_times(4, (C_word)NULL, k, x, y);
    } else if (C_immediatep(y)) {
      barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "*", x);
    } else if (C_block_header(y) == C_FLONUM_TAG) {
      C_kontinue(k, C_a_i_flonum_times(&a, 2, C_a_u_i_big_to_flo(&a, 1, x), y));
    } else if (C_IS_BIGNUM_TYPE(y)) {
      C_u_2_bignum_times(4, (C_word)NULL, k, x, y);
    } else {
      try_extended_number("numbers#@extended-2-times", 3, k, x, y);
    }
  } else {
    try_extended_number("numbers#@extended-2-times", 3, k, x, y);
  }
}

/* XXX TODO: Rework to allocate C_SIZEOF_BIGNUM(4)?  Not worth the hassle? */
/* Needs at most 2 * SIZEOF_FIX_BIGNUM + SIZEOF_BIGNUM(4) */
C_regparm C_word C_fcall
C_a_u_i_2_fixnum_times(C_word **ptr, C_word n, C_word x, C_word y)
{
  C_word absx, absy, negp;
  C_uword *d, r;

  /* We don't strictly need the abses in all branches... */
  absx = C_unfix(x);
  absx = absx < 0 ? -absx : absx;
  absy = C_unfix(y);
  absy = absy < 0 ? -absy : absy;
  negp = ((x & C_INT_SIGN_BIT) ? !(y & C_INT_SIGN_BIT) : (y & C_INT_SIGN_BIT));

  /* TODO: Figure out if it's worthwhile to shift left powers of 2.
   * Perhaps get rid of the rest of the nasty complexity below.
   */
  if (C_fitsinbignumhalfdigitp(absx)) {
     if (x == C_fix(0) || x == C_fix(1) || C_fitsinbignumhalfdigitp(absy)) {
       return C_fix(negp ? -(absx * absy) : (absx * absy));
     } else {
       if (y == C_fix(C_MOST_NEGATIVE_FIXNUM)) {
         y = C_bignum2(ptr, negp != 0, 0, 1); /* Two is always enough */
       } else {
         y = C_bignum2(ptr, negp != 0, absy, 0); /* May need one for carry */
       }
       d = C_bignum_digits(y);
       r = bignum_digits_destructive_scale_up_with_carry(d, d+2, absx, 0);
       assert(r == 0); /* Should never result in a carry; y is big enough */
       return C_bignum_simplify(y);
     }
  } else if (C_fitsinbignumhalfdigitp(absy)) {
     if (absy == 0 || y == C_fix(1) /*|| C_fitsinbignumhalfdigitp(absx) */) {
       return C_fix(negp ? -(absx * absy) : (absx * absy));
     } else {
       if (x == C_fix(C_MOST_NEGATIVE_FIXNUM)) {
         x = C_bignum2(ptr, negp != 0, 0, 1); /* Two is always enough */
       } else {
         x = C_bignum2(ptr, negp != 0, absx, 0); /* May need one for carry */
       }
       d = C_bignum_digits(x);
       r = bignum_digits_destructive_scale_up_with_carry(d, d+2, absy, 0);
       assert(r == 0); /* Should never result in a carry; x is big enough */
       return C_bignum_simplify(x);
     }
  } else {
    x = C_a_u_i_fix_to_big(ptr, x);
    y = C_a_u_i_fix_to_big(ptr, y);
    r = C_bignum4(ptr, negp != 0, 0, 0, 0, 0);
    bignum_digits_multiply(x, y, r);
    return C_bignum_simplify(r);
  }
}

void C_ccall
C_u_2_integer_times(C_word c, C_word self, C_word k, C_word x, C_word y)
{
  C_word ab[nmax(/* C_SIZEOF_FIX_BIGNUM, */ C_SIZEOF_CLOSURE(4),
                 C_SIZEOF_FIX_BIGNUM * 2 + C_SIZEOF_BIGNUM(4))],
         *a = ab, absy, negp, size, k2;

  if (x & C_FIXNUM_BIT) {
    if (y & C_FIXNUM_BIT) {
      C_kontinue(k, C_a_u_i_2_fixnum_times(&a, 2, x, y));
    } else {
      absy = x; /* swap to ensure x is a bignum and y a fixnum */
      x = y;
      y = absy;
    }
  }
  /* Here, we know for sure that X is a bignum */
  if (y == C_fix(0)) {
    C_kontinue(k, C_fix(0));
  } else if (y == C_fix(1)) {
    C_kontinue(k, x);
  } else if (y == C_fix(-1)) {
    C_u_bignum_negate(3, (C_word)NULL, k, x);
  } else if (y & C_FIXNUM_BIT) { /* Any other fixnum */
    C_word absy = (y & C_INT_SIGN_BIT) ? -C_unfix(y) : C_unfix(y),
           negp = C_mk_bool((y & C_INT_SIGN_BIT) ?
                            !C_bignum_negativep(x) :
                            C_bignum_negativep(x));
    int ylen = C_ilen(absy);
  
    if (C_fitsinbignumhalfdigitp(absy) ||
        ((ylen < C_BIGNUM_DIGIT_LENGTH) &&
         (((C_uword)1 << ylen-1) == absy))) {
      k2 = C_closure(&a, 4, (C_word)integer_times_2, k, x, C_fix(absy));
      size = C_fix(C_bignum_size(x) + 1); /* Needs _at most_ one more digit */
      C_allocate_bignum(5, (C_word)NULL, k2, size, negp, C_SCHEME_FALSE);
    } else {
      y = C_a_u_i_fix_to_big(&a, y);
      bignum_times_bignum_unsigned(k, x, y, negp);
    }
  } else {
    C_u_2_bignum_times(4, (C_word)NULL, k, x, y);
  }
}

static void
integer_times_2(C_word c, C_word self, C_word new_big)
{
  C_word k = C_block_item(self, 1),
	 old_bigx = C_block_item(self, 2),
	 absy = C_unfix(C_block_item(self, 3));
  C_uword *digits = C_bignum_digits(new_big),
	  *end_digit = digits + C_bignum_size(old_bigx);
  int shift;

  bignum_digits_destructive_copy(new_big, old_bigx);

  /* Scale up, and sanitise the result. */
  shift = C_ilen(absy) - 1;
  if (((C_uword)1 << shift) == absy) { /* Power of two? */
    *end_digit = bignum_digits_destructive_shift_left(digits, end_digit, shift);
  } else {
    *end_digit =
      bignum_digits_destructive_scale_up_with_carry(digits, end_digit, absy, 0);
  }
  C_kontinue(k, C_bignum_simplify(new_big));
}

void C_ccall
C_u_2_bignum_times(C_word c, C_word self, C_word k, C_word x, C_word y)
{
  C_word negp = C_bignum_negativep(x) ?
                !C_bignum_negativep(y) :
                C_bignum_negativep(y);
  bignum_times_bignum_unsigned(k, x, y, C_mk_bool(negp));
}

static void
bignum_times_bignum_unsigned(C_word k, C_word x, C_word y, C_word negp)
{
  if (C_bignum_size(y) < C_bignum_size(x)) { /* Ensure size(x) <= size(y) */
    C_word z = x;
    x = y;
    y = z;
  }

  if (C_bignum_size(x) > C_KARATSUBA_THRESHOLD) {
    try_extended_number("numbers#@bignum-2-times-karatsuba", 3, k, x, y);
  } else { /* Use gradebook multiplication */
    C_word kab[C_SIZEOF_CLOSURE(4)], *ka = kab, k2, size;
  
    k2 = C_closure(&ka, 4, (C_word)bignum_times_bignum_unsigned_2, k, x, y);

    size = C_fix(C_bignum_size(x) + C_bignum_size(y));
    C_allocate_bignum(5, (C_word)NULL, k2, size, negp, C_SCHEME_TRUE);
  }
}

/* Multiplication
   Maximum value for product_lo or product_hi:
        ((R * R) + (R * (R - 2)) + (R - 1))
   Maximum value for carry: ((R * (R - 1)) + (R - 1))
        where R == 2^HALF_DIGIT_LENGTH */
static C_regparm void
bignum_digits_multiply(C_word x, C_word y, C_word result)
{
  C_uword carry, y_digit_lo, y_digit_hi, x_digit_lo,
          x_digit_hi, product_lo, *scan_r, *scan_y,
          x_digit, y_digit, product_hi,
	  *scan_x = C_bignum_digits(x),
          *end_x = scan_x + C_bignum_size(x),
          *start_y = C_bignum_digits(y),
          *end_y = start_y + C_bignum_size(y),
          *start_r = C_bignum_digits(result);

  while (scan_x < end_x) {
    x_digit = (*scan_x++);
    x_digit_lo = C_BIGNUM_DIGIT_LO_HALF(x_digit);
    x_digit_hi = C_BIGNUM_DIGIT_HI_HALF(x_digit);
    carry = 0;
    scan_y = start_y;
    scan_r = (start_r++);

    while (scan_y < end_y) {
      y_digit = (*scan_y++);
      y_digit_lo = C_BIGNUM_DIGIT_LO_HALF(y_digit);
      y_digit_hi = C_BIGNUM_DIGIT_HI_HALF(y_digit);

      product_lo = (*scan_r) +
                   x_digit_lo * y_digit_lo +
                   C_BIGNUM_DIGIT_LO_HALF(carry);

      product_hi = x_digit_hi * y_digit_lo +
                   x_digit_lo * y_digit_hi +
                   C_BIGNUM_DIGIT_HI_HALF(product_lo) +
                   C_BIGNUM_DIGIT_HI_HALF(carry);

      (*scan_r++) = C_BIGNUM_DIGIT_COMBINE(C_BIGNUM_DIGIT_LO_HALF(product_hi),
                                           C_BIGNUM_DIGIT_LO_HALF(product_lo));

      carry = x_digit_hi * y_digit_hi + C_BIGNUM_DIGIT_HI_HALF(product_hi);
    }
    (*scan_r) += carry;
  }
}

static void
bignum_times_bignum_unsigned_2(C_word c, C_word self, C_word result)
{
  C_word k = C_block_item(self, 1),
	 x = C_block_item(self, 2),
	 y = C_block_item(self, 3);

  bignum_digits_multiply(x, y, result);
  C_kontinue(k, C_bignum_simplify(result));
}

void C_ccall
C_digits_to_integer(C_word c, C_word self, C_word k, C_word str,
                    C_word start, C_word end, C_word radix, C_word negp)
{
  C_word kab[C_SIZEOF_CLOSURE(6)], *ka = kab, k2, size;
  size_t nbits;

  assert((C_unfix(radix) > 1) && C_fitsinbignumhalfdigitp(C_unfix(radix)));
  
  if (start == end) {
    C_kontinue(k, C_SCHEME_FALSE);
  } else {
    k2 = C_closure(&ka, 6, (C_word)digits_to_integer_2, k, str, start, end, radix);
  
    nbits = (C_unfix(end) - C_unfix(start)) * C_ilen(C_unfix(radix));
    size = C_fix(C_BIGNUM_BITS_TO_DIGITS(nbits));
    /* XXX: Why initialize? */
    C_allocate_bignum(5, (C_word)NULL, k2, size, negp, C_SCHEME_TRUE);
  }
}

/* XXX TODO: This should be faster, dammit! */
static void
digits_to_integer_2(C_word c, C_word self, C_word result)
{
  C_word k = C_block_item(self, 1),
         str = C_block_item(self, 2),
         start = C_unfix(C_block_item(self, 3)),
         end = C_unfix(C_block_item(self, 4)),
         radix = C_unfix(C_block_item(self, 5));
  C_uword *digits = C_bignum_digits(result),
          *last_digit = digits, /* Initially, bignum is all zeroes */
          big_digit = 0, next_big_digit, factor, next_factor,
          carry, str_digit;
  char *str_scan = C_c_string(str) + start,
       *str_end = C_c_string(str) + end;
  int radix_shift;

  /* Hash characters in numbers are mapped to 0 */
# define HEXDIGIT_CHAR_TO_INT(x)					\
    (((x) == '#') ? 0 :							\
     (((x) >= (int)'a') ? ((x) - (int)'a' + 10) : ((x) - (int)'0')))

  /* Below, we try to save up as much as possible in the local C_word
   * big_digit, and only when it exceeds what we would be able to
   * multiply easily, we scale up the bignum and add what we saved up.
   */
  radix_shift = C_ilen(radix) - 1;
  if (((C_uword)1 << radix_shift) == radix) { /* Power of two? */
    factor = 0;
    *(last_digit++) = 0; /* Ensure we start with something to shift */

    while (str_scan < str_end) {
      str_digit = HEXDIGIT_CHAR_TO_INT(C_tolower((int)*str_scan));
      str_scan++;

      next_big_digit = (big_digit << radix_shift) | str_digit;
      next_factor = factor + radix_shift;

      if (str_digit >= radix || str_digit < 0) {
        C_kontinue(k, C_SCHEME_FALSE);
      } else if (next_factor < C_BIGNUM_DIGIT_LENGTH) {
        factor = next_factor;
        big_digit = next_big_digit;
      } else {
        carry = bignum_digits_destructive_shift_left(digits,last_digit,factor);
	*digits |= big_digit;

        if (carry) (*last_digit++) = carry; /* Move end */

        big_digit = str_digit;
        factor = radix_shift;
      }
    }

    /* Final step.  We always must do this, because the loop never
     * processes the "current" character into the bignum (lookahead 1).
     */
    carry = bignum_digits_destructive_shift_left(digits, last_digit, factor);
    if (carry) (*last_digit++) = carry; /* Move end */
    *digits |= big_digit;
    
  } else {			/* Not a power of two */
    factor = 1;

    while (str_scan < str_end) {
      str_digit = HEXDIGIT_CHAR_TO_INT(C_tolower((int)*str_scan));
      str_scan++;

      next_big_digit = big_digit * radix;
      next_big_digit += str_digit;
      next_factor = factor * radix;

      if (str_digit >= radix || str_digit < 0) {
        C_kontinue(k, C_SCHEME_FALSE);
      } else if (C_fitsinbignumhalfdigitp(next_factor)) {
        factor = next_factor;
        big_digit = next_big_digit;
      } else {
        carry = bignum_digits_destructive_scale_up_with_carry(
                digits, last_digit, factor, big_digit);

        if (carry) (*last_digit++) = carry; /* Move end */

        big_digit = str_digit;
        factor = radix;
      }
    }

    /* Final step.  We always must do this, because the loop never
     * processes the "current" character into the bignum (lookahead 1).
     */
    carry = bignum_digits_destructive_scale_up_with_carry(
            digits, last_digit, factor, big_digit);
    if (carry) (*last_digit++) = carry; /* Move end */
  }
# undef HEXDIGIT_CHAR_TO_INT

  C_kontinue(k, C_bignum_simplify(result));
}

/* TODO: Copied from runtime.c */
# define STRING_BUFFER_SIZE   4096

static C_TLS C_char buffer[ STRING_BUFFER_SIZE ];
static char *to_n_nary(C_uword num, C_uword base)
{
  static char *digits = "0123456789ABCDEF";
  char *p;
  buffer [ 66 ] = '\0';
  p = buffer + 66;

  do {
    *(--p) = digits [ num % base ];
    num /= base;
  } while (num);

  return p;
}

void C_ccall C_basic_number_to_string(C_word c, C_word closure, C_word k, C_word num, ...)
{
  C_word radix;

  if(c == 3) {
    radix = C_fix(10);
  } else if(c == 4) {
    va_list v;

    va_start(v, num);
    radix = va_arg(v, C_word);
    va_end(v);
    
    if(!(radix & C_FIXNUM_BIT))
      barf(C_BAD_ARGUMENT_TYPE_BAD_BASE_ERROR, "number->string", radix);
  } else {
    C_bad_argc(c, 3);
  }

  if(num & C_FIXNUM_BIT) {
    C_u_fixnum_to_string(4, (C_word)NULL, k, num, radix);
  } else if (C_immediatep(num)) {
    barf(C_BAD_ARGUMENT_TYPE_ERROR, "number->string", num);
  } else if(C_block_header(num) == C_FLONUM_TAG) {
    C_u_flonum_to_string(4, (C_word)NULL, k, num, radix);
  } else if (C_IS_BIGNUM_TYPE(num)) {
    C_u_bignum_to_string(4, (C_word)NULL, k, num, radix);
  } else {
    try_extended_number("numbers#@extended-number->string", 3, k, num, radix);
  }
}

/* Naming is a little inconsistent, but looks saner.  We're not R-O-B-O-T-S! */
void C_ccall
C_u_integer_to_string(C_word c, C_word self, C_word k, C_word num, C_word radix)
{
  /* Trivial to the point of stupidity? */
  if (num & C_FIXNUM_BIT)
    C_u_fixnum_to_string(4, (C_word)NULL, k, num, radix);
  else
    C_u_bignum_to_string(4, (C_word)NULL, k, num, radix);
}

/* Should we get rid of C_fixnum_to_string? */
void C_ccall
C_u_fixnum_to_string(C_word c, C_word self, C_word k, C_word num, C_word radix)
{
  C_word *a, neg = 0;
  C_char *p;

  num = C_unfix(num);
  radix = C_unfix(radix);

  if((radix < 2) || (radix > 16)){
    barf(C_BAD_ARGUMENT_TYPE_BAD_BASE_ERROR, "number->string", C_fix(radix));
  }

  if(num < 0) {
    neg = 1;
    num = -num; /* snprintf's %x and %o always interpret number as unsigned */
  }

  switch(radix) {
#ifdef C_SIXTY_FOUR
  case 8: C_snprintf(p = buffer + 1, sizeof(buffer) -1 , C_text("%llo"), (long long)num); break;
  case 10: C_snprintf(p = buffer + 1, sizeof(buffer) - 1, C_text("%lld"), (long long)num); break;
  case 16: C_snprintf(p = buffer + 1, sizeof(buffer) - 1, C_text("%llx"), (long long)num); break;
#else
  case 8: C_snprintf(p = buffer + 1, sizeof(buffer) - 1, C_text("%o"), num); break;
  case 10: C_snprintf(p = buffer + 1, sizeof(buffer) - 1, C_text("%d"), num); break;
  case 16: C_snprintf(p = buffer + 1, sizeof(buffer) - 1, C_text("%x"), num); break;
#endif
  default: 
    p = to_n_nary(num, radix);
  }

  if(neg) *(--p) = '-';

  radix = C_strlen(p);
  a = C_alloc((C_bytestowords(radix) + 1));
  radix = C_string(&a, radix, p);
  C_kontinue(k, radix);
}

void C_ccall
C_u_flonum_to_string(C_word c, C_word self, C_word k, C_word num, C_word radix)
{
  C_word *a, neg = 0;
  C_char *p;
  double f;

  radix = C_unfix(radix);
  f = C_flonum_magnitude(num);

  /* XXX TODO: Should inexacts be printable in other bases than 10?
   * Perhaps output a string starting with #i?
   * Right now something like (number->string 1e40 16) results in
   * a string that can't be read back using string->number.
   */
  if((radix < 2) || (radix > 16)){
    barf(C_BAD_ARGUMENT_TYPE_BAD_BASE_ERROR, "number->string", C_fix(radix));
  }

  if(C_fits_in_unsigned_int_p(num) == C_SCHEME_TRUE) {
    if(f < 0) {
      neg = 1;
      f = -f;
    }

    switch(radix) {
    case 8:
      C_snprintf(p = buffer, sizeof(buffer), "%o", (unsigned int)f);
      goto fini;

    case 16:
      C_snprintf(p = buffer, sizeof(buffer), "%x", (unsigned int)f);
      goto fini;

    case 10: break;           /* force output of decimal point to retain
                                 read/write invariance (the little we support) */

    default:
      p = to_n_nary((unsigned int)f, radix);
      goto fini;
    }
  } 

  if(C_isnan(f)) {
    /* XXX Back-compat support for CHICKENS older than 4.9.0 */
#if defined(HAVE_STRLCPY) || !defined(C_strcpy)
    C_strlcpy(buffer, C_text("+nan.0"), sizeof(buffer));
    p = buffer;
#else
    C_strcpy(p = buffer, "+nan.0");
#endif
    goto fini;
  } else if(C_isinf(f)) {
    C_snprintf(buffer, sizeof(buffer), "%cinf.0", f > 0 ? '+' : '-');
    p = buffer;
    goto fini;
  }

  C_snprintf(buffer, STRING_BUFFER_SIZE, C_text("%.*g"),
	     /* XXX: flonum_print_precision */
	       (int)C_unfix(C_get_print_precision()), f);
  buffer[STRING_BUFFER_SIZE-1] = '\0';

  if((p = C_strpbrk(buffer, C_text(".eE"))) == NULL) {
    if(*buffer == 'i' || *buffer == 'n') { /* inf or nan */
	C_memmove(buffer + 1, buffer, C_strlen(buffer) + 1);
	*buffer = '+';
    }
#if defined(HAVE_STRLCAT) || !defined(C_strcat)
    else if(buffer[ 1 ] != 'i') C_strlcat(buffer, C_text(".0"), sizeof(buffer)); /* negative infinity? */
#else
    else if(buffer[ 1 ] != 'i') C_strcat(buffer, C_text(".0")); /* negative infinity? */
#endif
  }

  p = buffer;

 fini:
  if(neg) *(--p) = '-';

  radix = C_strlen(p);
  a = C_alloc((C_bytestowords(radix) + 1));
  radix = C_string(&a, radix, p);
  C_kontinue(k, radix);
}

void C_ccall
C_u_bignum_to_string(C_word c, C_word self, C_word k, C_word num, C_word radix)
{
  C_word kab[C_SIZEOF_CLOSURE(4)], *ka = kab, k2, len,
         negp = C_mk_bool(C_bignum_negativep(num));

  if((C_unfix(radix) < 2) || (C_unfix(radix) > 16)){
    barf(C_BAD_ARGUMENT_TYPE_BAD_BASE_ERROR, "number->string", radix);
  }

  /* Approximation of the number of radix digits we'll need.  We try
   * to be as precise as possible to avoid memmove overhead at the end
   * of the conversion procedure, which we may need to do because we
   * write strings back-to-front, and pointers must be aligned (even
   * for byte blocks).
   */
  len = C_ilen(C_unfix(radix))-1;
  len = (C_unfix(C_u_i_bignum_length(num)) + len - 1) / len;
  len += C_bignum_negativep(num) ? 1 : 0;

  k2 = C_closure(&ka, 4, (C_word)bignum_to_digits_2, k, num, radix);
  C_allocate_vector(6, (C_word)NULL, k2, C_fix(len),
                    /* Byte vec, no initialization, align at 8 bytes */
                    C_SCHEME_TRUE, C_SCHEME_FALSE, C_SCHEME_FALSE);
}

static void
bignum_to_digits_2(C_word c, C_word self, C_word string)
{
  static char *characters = "0123456789abcdef";
  C_word k = C_block_item(self, 1),
         num = C_block_item(self, 2),
         radix = C_unfix(C_block_item(self, 3)),
	 negp = (C_bignum_negativep(num) ? 1 : 0),
         len = C_header_size(string) + negp,
         numlen = C_bignum_size(num),
         working_copy;
  C_uword *start, *scan, digit;
  char *buf = C_c_string(string), *index = buf + C_header_size(string) - 1;
  int steps, i, radix_shift;

  working_copy = allocate_tmp_bignum(C_fix(numlen), C_mk_bool(negp),
				     C_SCHEME_FALSE);
  bignum_digits_destructive_copy(working_copy, num);

  start = C_bignum_digits(working_copy);
  scan = start + numlen;

  radix_shift = C_ilen(radix) - 1;
  if (((C_uword)1 << radix_shift) == radix) { /* Power of two? */
    int base_shift, radix_mask = radix-1;

    /* Figure out biggest power of radix that fits in bignum digit */
    for(steps = 0, base_shift = radix_shift;
	base_shift < C_BIGNUM_DIGIT_LENGTH; base_shift += radix_shift)
      steps++;

    base_shift -= radix_shift; /* Back down: we overshot in the loop */

    while (start < scan) {
      digit = bignum_digits_destructive_shift_right(start, scan, base_shift);

      if (*(scan-1) == 0) scan--; /* Adjust if we exhausted the highest digit */

      for(i = 0; i < steps && index >= buf; ++i) {
        *index-- = characters[digit & radix_mask];
        digit >>= radix_shift;
      }
    }
  } else { /* XXX TODO: This should be MUCH faster, dammit! */
    C_uword base;
    /* Calculate the largest power of radix that fits a halfdigit:
     * steps = log10(2^halfdigit_bits), base = 10^steps
     */
    for(steps = 0, base = radix; C_fitsinbignumhalfdigitp(base); base *= radix)
      steps++;

    base /= radix; /* Back down: we overshot in the loop */

    while (start < scan) {
      digit = bignum_digits_destructive_scale_down(start, scan, base);

      if (*(scan-1) == 0) scan--; /* Adjust if we exhausted the highest digit */

      for(i = 0; i < steps && index >= buf; ++i) {
        *index-- = characters[digit % radix];
        digit /= radix;
      }
    }
  }
  assert(index >= buf-1);

  /* Move index onto first nonzero digit.  We're writing a bignum
     here: it can't consist of only zeroes. */
  while(*++index == '0');

  if (negp) *--index = '-';

  /* Shorten with distance between start and index. */
  len = C_header_size(string) - (index - buf);
  if (buf != index) {
    C_memmove(buf, index, len); /* Move start of number to begin of string. */
    C_block_header(string) = C_STRING_TYPE | len; /* Mutate string length. */
  }
  free_tmp_bignum(working_copy);
  C_kontinue(k, string);
}

C_regparm double C_bignum_to_double(C_word bignum)
{
  double accumulator = 0;
  C_uword *start = C_bignum_digits(bignum),
          *scan = start + C_bignum_size(bignum);
  while (start < scan) {
    accumulator *= (C_word)1 << C_BIGNUM_DIGIT_LENGTH;
    accumulator += (*--scan);
  }
  return(C_bignum_negativep(bignum) ? -accumulator : accumulator);
}

static void
fabs_frexp_to_digits(C_uword exp, double sign, C_uword *start, C_uword *scan)
{
  C_uword digit, odd_bits = exp % C_BIGNUM_DIGIT_LENGTH;

  assert(C_isfinite(sign));
  assert(0.5 <= sign && sign < 1); /* Guaranteed by frexp() and fabs() */
  assert((scan - start) == C_BIGNUM_BITS_TO_DIGITS(exp));
  
  if (odd_bits > 0) { /* Handle most significant digit first */
    sign *= (C_uword)1 << odd_bits;
    digit = (C_uword)sign;
    (*--scan) = digit;
    sign -= (double)digit;
  }

  while (start < scan && sign > 0) {
    sign *= (C_uword)1 << C_BIGNUM_DIGIT_LENGTH;
    digit = (C_uword)sign;
    (*--scan) = digit;
    sign -= (double)digit;
  }

  /* Finish up by clearing any remaining, lower, digits */
  while (start < scan)
    (*--scan) = 0;
}

static C_word
flo_to_tmp_bignum(C_word x)
{
  /* TODO: allocating and initialising the bignum is pointless if we
   * already know the number of limbs in the comparand.  In fact,
   * bignum_cmp will first check the number of limbs and *then*
   * compare.  Instead, we can check beforehand and check the limbs
   * directly against the generated limbs, without allocating at all!
   */
  C_word tmp_big, negp = C_mk_bool(C_flonum_magnitude(x) < 0.0);
  int exponent;
  double significand = frexp(C_flonum_magnitude(x), &exponent);

  assert(C_u_i_fpintegerp(x));

  if (exponent <= 0) {
    tmp_big = allocate_tmp_bignum(C_fix(0), C_SCHEME_FALSE, C_SCHEME_FALSE);
  } else if (exponent == 1) { /* TODO: check significand * 2^exp fits fixnum? */
    /* Don't use fix_to_big to simplify caller code: it can just free this */
    tmp_big = allocate_tmp_bignum(C_fix(1), negp, C_SCHEME_FALSE);
    C_bignum_digits(tmp_big)[0] = 1;
  } else {
    C_word size, *start, *end;

    size = C_fix(C_BIGNUM_BITS_TO_DIGITS(exponent));

    tmp_big = allocate_tmp_bignum(size, negp, C_SCHEME_FALSE);
    start = C_bignum_digits(tmp_big);
    end = start + C_bignum_size(tmp_big);

    fabs_frexp_to_digits(exponent, fabs(significand), start, end);
  }
  return tmp_big;
}

void C_ccall
C_u_flo_to_int(C_word c, C_word self, C_word k, C_word loc, C_word x)
{
  int exponent;
  double significand = frexp(C_flonum_magnitude(x), &exponent);

  if (!C_truep(C_u_i_fpintegerp(x))) { /* Calling frexp first is okay */
    barf(C_BAD_ARGUMENT_TYPE_NO_INTEGER_ERROR, C_strloc(loc), x);
  } else if (exponent <= 0) {
    C_kontinue(k, C_fix(0));
  } else if (exponent == 1) { /* TODO: check significand * 2^exp fits fixnum? */
    C_kontinue(k, significand < 0.0 ? C_fix(-1) : C_fix(1));
  } else {
    C_word kab[C_SIZEOF_CLOSURE(4) + C_SIZEOF_FLONUM], *ka = kab, k2, size,
           negp = C_mk_bool(C_flonum_magnitude(x) < 0.0),
           sign = C_flonum(&ka, fabs(significand));

    k2 = C_closure(&ka, 4, (C_word)flo_to_int_2, k, C_fix(exponent), sign);

    size = C_fix(C_BIGNUM_BITS_TO_DIGITS(exponent));
    C_allocate_bignum(5, (C_word)NULL, k2, size, negp, C_SCHEME_FALSE);
  }
}

static void
flo_to_int_2(C_word c, C_word self, C_word result)
{
  C_word k = C_block_item(self, 1);
  C_uword exponent = C_unfix(C_block_item(self, 2)),
          *start = C_bignum_digits(result),
          *scan = start + C_bignum_size(result);
  double significand = C_flonum_magnitude(C_block_item(self, 3));

  fabs_frexp_to_digits(exponent, significand, start, scan);
  C_kontinue(k, C_bignum_simplify(result));
}

C_word C_ccall
C_u_i_integer_length(C_word x)
{
  if (x & C_FIXNUM_BIT) return C_u_i_fixnum_length(x);
  else return C_u_i_bignum_length(x);
}

C_word C_ccall
C_u_i_bignum_length(C_word x)
{
    C_uword len_1 = C_bignum_size(x) - 1,
            result = len_1 * C_BIGNUM_DIGIT_LENGTH,
            *startx = C_bignum_digits(x),
            *last_digit = C_bignum_digits(x) + len_1,
            last_digit_length = C_ilen(*last_digit);

    /* If *only* the highest bit is set, negating results in one less bit */
    if (C_bignum_negativep(x) && *last_digit == (1 << (last_digit_length-1))) {
      while(startx < last_digit && *startx == 0) ++startx;
      if (startx == last_digit) result--;
    }
    return C_fix(result + last_digit_length);
}

void C_ccall /* x is any exact integer but y is _always_ a fixnum */
C_u_integer_shift(C_word c, C_word self, C_word k, C_word x, C_word y)
{
  C_word kab[C_SIZEOF_FIX_BIGNUM * 2 + C_SIZEOF_CLOSURE(3) + C_SIZEOF_CLOSURE(2)],
         *ka = kab, k2, k3, minus1;

  if (y == C_fix(0) || x == C_fix(0)) { /* Done (no shift) */
    C_kontinue(k, x);
  } else if (x & C_FIXNUM_BIT) {
    if (C_unfix(y) < 0) {
      /* Don't shift more than a word's length (that's undefined in C!) */
      if (-C_unfix(y) < C_WORD_SIZE) {
        C_kontinue(k, C_fix(C_unfix(x) >> -C_unfix(y)));
      } else {
        C_kontinue(k, (x & C_INT_SIGN_BIT) ? C_fix(-1) : C_fix(0));
      }
    } else if (C_unfix(y) > 0 && C_unfix(y) < C_WORD_SIZE-2 &&
	       /* After shifting, the length should still fit a fixnum */
	       (C_ilen(C_unfix(x)) + C_unfix(y)) < C_WORD_SIZE-2) {
      C_kontinue(k, C_fix(C_unfix(x) << C_unfix(y)));
    } else {
      x = C_a_u_i_fix_to_big(&ka, x);
    }
  }

  /* Invert all the bits before shifting right a negative value */
  if (C_bignum_negativep(x) && C_unfix(y) < 0) {
    /* When done shifting, invert again */
    k3 = C_closure(&ka, 2, (C_word)bignum_negate_after_shift, k);
    /* Before shifting, allocate the bignum */
    k2 = C_closure(&ka, 3, (C_word)bignum_allocate_for_shift, k3, y);
    /* Actually invert by subtracting: -1 - x */
    minus1 = C_a_u_i_fix_to_big(&ka, C_fix(-1));
    C_u_2_bignum_minus(4, (C_word)NULL, k2, minus1, x);
  } else {
    k2 = C_closure(&ka, 3, (C_word)bignum_allocate_for_shift, k, y);
    C_kontinue(k2, x);
  }
}

static void
bignum_allocate_for_shift(C_word c, C_word self, C_word x)
{
  C_word k = C_block_item(self, 1),
	 y = C_block_item(self, 2),
         uy = C_unfix(y),
	 negp, digit_offset, bit_offset,
         ab[C_SIZEOF_FIX_BIGNUM + C_SIZEOF_CLOSURE(6)], *a = ab, k2, size;

  if (x & C_FIXNUM_BIT) /* Normalisation may happen after negation */
    x = C_a_u_i_fix_to_big(&a, x);

  negp = C_mk_bool(C_bignum_negativep(x));
  
  /* uy is guaranteed not to be 0 here */
  if (uy > 0) {
    digit_offset = uy / C_BIGNUM_DIGIT_LENGTH;
    bit_offset =   uy % C_BIGNUM_DIGIT_LENGTH;

    k2 = C_closure(&a, 6, (C_word)bignum_actual_shift, k,
                   x, C_SCHEME_TRUE, C_fix(digit_offset), C_fix(bit_offset));
    size = C_fix(C_bignum_size(x) + digit_offset + 1);
    C_allocate_bignum(5, (C_word)NULL, k2, size, negp, C_SCHEME_TRUE);
  } else if (-uy >= C_bignum_size(x) * (C_word)C_BIGNUM_DIGIT_LENGTH) {
    /* All bits are shifted out, just return 0 */
    C_kontinue(k, C_fix(0));
  } else {
    digit_offset = -uy / C_BIGNUM_DIGIT_LENGTH;
    bit_offset =   -uy % C_BIGNUM_DIGIT_LENGTH;
    
    k2 = C_closure(&a, 6, (C_word)bignum_actual_shift, k,
                   x, C_SCHEME_FALSE, C_fix(digit_offset), C_fix(bit_offset));
    size = C_fix(C_bignum_size(x) - digit_offset);
    C_allocate_bignum(5, (C_word)NULL, k2, size, negp, C_SCHEME_TRUE);
  }
}

static void
bignum_negate_after_shift(C_word c, C_word self, C_word result)
{
  C_word k = C_block_item(self, 1);
  if (result & C_FIXNUM_BIT) { /* Normalisation may happen after shift */
    C_kontinue(k, C_fix(-1 - C_unfix(result)));
  } else {
    C_word ab[C_SIZEOF_FIX_BIGNUM], *a = ab, minus1;
    minus1 = C_a_u_i_fix_to_big(&a, C_fix(-1));
    C_u_2_bignum_minus(4, (C_word)NULL, k, minus1, result);
  }
}

static void
bignum_actual_shift(C_word c, C_word self, C_word result)
{
  C_word k = C_block_item(self, 1),
         x = C_block_item(self, 2),
         shift_left = C_truep(C_block_item(self, 3)),
         digit_offset = C_unfix(C_block_item(self, 4)),
         bit_offset = C_unfix(C_block_item(self, 5));
  C_uword *startr = C_bignum_digits(result),
          *startx = C_bignum_digits(x),
          *endx = startx + C_bignum_size(x),
          *endr = startr + C_bignum_size(result);

  if (shift_left) {
    startr += digit_offset;
    /* Can't use bignum_digits_destructive_copy because it assumes
     * we want to copy from the start.
     */
    C_memcpy(startr, startx, C_wordstobytes(endx-startx));
    bignum_digits_destructive_shift_left(startr, endr, bit_offset);
  } else {
    startx += digit_offset;
    /* Can't use bignum_digits_destructive_copy because that assumes
     * target is at least as big as source.
     */
    C_memcpy(startr, startx, C_wordstobytes(endr-startr));
    bignum_digits_destructive_shift_right(startr, endr, bit_offset);
  }
  C_kontinue(k, C_bignum_simplify(result));
}

/* This is currently only used by Karatsuba multiplication.  If we
 * expose it, it should probably be like "bit-field" from SRFI-60,
 * i.e. it should accept a start and end instead of just a count.
 * It should then also be changed to allow negative values.
 */
void C_ccall
C_u_bignum_extract_bits(C_word c, C_word self, C_word k, C_word x, C_word bits)
{
  C_word negp, full_digits, top_digit_bits,
         ab[C_SIZEOF_FIX_BIGNUM + C_SIZEOF_CLOSURE(5)], *a = ab, k2, size;

  negp = C_mk_bool(C_bignum_negativep(x)); /* Always false */
  
  full_digits    = C_unfix(bits) / C_BIGNUM_DIGIT_LENGTH;
  top_digit_bits = C_unfix(bits) % C_BIGNUM_DIGIT_LENGTH;

  if (full_digits > C_bignum_size(x)) { /* TODO: Move this upwards */
    C_kontinue(k, x);
  } else {
    k2 = C_closure(&a, 5, (C_word)bignum_actual_extraction, k,
                   x, C_fix(full_digits), C_fix(top_digit_bits));

    size = C_fix(full_digits + (top_digit_bits > 0 ? 1 : 0));
    C_allocate_bignum(5, (C_word)NULL, k2, size, negp, C_SCHEME_FALSE);
  }
}

static void
bignum_actual_extraction(C_word c, C_word self, C_word result)
{
  C_word k = C_block_item(self, 1),
         x = C_block_item(self, 2),
         full_digits = C_unfix(C_block_item(self, 3)),
         top_digit_bits = C_unfix(C_block_item(self, 4));
  C_uword mask = ((C_uword)1 << top_digit_bits) - 1,
          *result_digits = C_bignum_digits(result),
          *x_digits = C_bignum_digits(x);

  /* Can't use bignum_digits_destructive_copy because that assumes
   * target is at least as big as source.
   */
  C_memcpy(result_digits, x_digits, C_wordstobytes(full_digits));

  if (top_digit_bits != 0)
    result_digits[full_digits] = x_digits[full_digits] & mask;
  
  C_kontinue(k, C_bignum_simplify(result));
}

C_regparm C_word C_ccall C_u_i_integer_randomize(C_word seed)
{
  /* TODO: Rename C_randomize to C_u_i_fixnum_randomize */
  if (seed & C_FIXNUM_BIT) return C_randomize(seed);
  else return C_u_i_bignum_randomize(seed);
}

/*
 * This random number generator is very simple. Probably too simple...
 */
C_word C_ccall
C_u_i_bignum_randomize(C_word bignum)
{
  C_uword seed = 0,
          *scan = C_bignum_digits(bignum),
          *end = scan + C_bignum_size(bignum);

  /* What a cheap way to initialize the random generator. I feel dirty! */
  while (scan < end)
    seed ^= *scan++;

  srand(seed);
  return C_SCHEME_UNDEFINED;
}

void C_ccall
C_u_integer_random(C_word c, C_word self, C_word k, C_word max)
{
  /* TODO: for consistency C_random_fixnum should be called C_u_i_fixnum_random */
  if (max & C_FIXNUM_BIT) C_kontinue(k, C_random_fixnum(max));
  else C_u_bignum_random(3, (C_word)NULL, k, max);
}

void C_ccall
C_u_bignum_random(C_word c, C_word self, C_word k, C_word max)
{
  C_word k2, kab[C_SIZEOF_CLOSURE(4)], *ka = kab, size,
         max_len, max_bits, max_top_digit, d, negp;

  max_len = C_bignum_size(max);
  max_top_digit = d = C_bignum_digits(max)[max_len - 1];
  
  max_bits = (max_len - 1) * C_BIGNUM_DIGIT_LENGTH;
  while(d) {
    max_bits++;
    d >>= 1;
  }
  /* Subtract/add one because we don't want zero to be over-represented */
  size = ((double)rand())/(RAND_MAX + 1.0) * (double)(max_bits - 1);
  size = C_fix(C_BIGNUM_BITS_TO_DIGITS(size + 1));

  negp = C_mk_bool(C_bignum_negativep(max));
  k2 = C_closure(&ka, 4, (C_word)bignum_random_2, k, C_fix(max_top_digit), C_fix(max_len));
  C_allocate_bignum(5, (C_word)NULL, k2, size, negp, C_SCHEME_FALSE);
}

static void
bignum_random_2(C_word c, C_word self, C_word result)
{
  C_word k = C_block_item(self, 1),
         max_top_digit = C_unfix(C_block_item(self, 2)),
         max_len = C_unfix(C_block_item(self, 3));
  C_uword *scan = C_bignum_digits(result),
          *end = scan + C_bignum_size(result); /* Go to just before the end. */

  while(scan < end)
    *scan++ = ((double)rand())/(RAND_MAX + 1.0) * (double)((C_word)1 << C_BIGNUM_DIGIT_LENGTH);
  /*
   * Last word is special when length is max_len: It must be less than
   * max's most significant digit, instead of BIGNUM_RADIX.
   */
  if (max_len == C_bignum_size(result))
    *scan = ((double)rand())/(RAND_MAX + 1.0) * (double)max_top_digit;
  else
    *scan = ((double)rand())/(RAND_MAX + 1.0) * (double)((C_word)1 << C_BIGNUM_DIGIT_LENGTH);

  C_kontinue(k, C_bignum_simplify(result));
}

void C_ccall
C_u_2_integer_bitwise_and(C_word c, C_word self, C_word k, C_word x, C_word y)
{
  C_word ab[C_SIZEOF_FIX_BIGNUM*2], *a = ab;
  if (x & C_FIXNUM_BIT) {
    if (y & C_FIXNUM_BIT) {
      C_kontinue(k, C_u_fixnum_and(x, y));
    } else {
      x = C_a_u_i_fix_to_big(&a, x);
    }
  }
  if (y & C_FIXNUM_BIT)
    y = C_a_u_i_fix_to_big(&a, y);

  C_u_2_bignum_bitwise_op(5, (C_word)NULL, k, C_fix(0), x, y);
}

void C_ccall
C_u_2_integer_bitwise_ior(C_word c, C_word self, C_word k, C_word x, C_word y)
{
  C_word ab[C_SIZEOF_FIX_BIGNUM*2], *a = ab;
  if (x & C_FIXNUM_BIT) {
    if (y & C_FIXNUM_BIT) {
      C_kontinue(k, C_u_fixnum_or(x, y));
    } else {
      x = C_a_u_i_fix_to_big(&a, x);
    }
  }
  if (y & C_FIXNUM_BIT)
    y = C_a_u_i_fix_to_big(&a, y);

  C_u_2_bignum_bitwise_op(5, (C_word)NULL, k, C_fix(1), x, y);
}

void C_ccall
C_u_2_integer_bitwise_xor(C_word c, C_word self, C_word k, C_word x, C_word y)
{
  C_word ab[C_SIZEOF_FIX_BIGNUM*2], *a = ab;
  if (x & C_FIXNUM_BIT) {
    if (y & C_FIXNUM_BIT) {
      C_kontinue(k, C_fixnum_xor(x, y));
    } else {
      x = C_a_u_i_fix_to_big(&a, x);
    }
  }
  if (y & C_FIXNUM_BIT)
    y = C_a_u_i_fix_to_big(&a, y);

  C_u_2_bignum_bitwise_op(5, (C_word)NULL, k, C_fix(2), x, y);
}

/* op identifies the operator: 0 means AND, 1 means IOR, 2 means XOR */
void C_ccall
C_u_2_bignum_bitwise_op(C_word c, C_word self, C_word k, C_word op, C_word x, C_word y)
{
  C_word kab[C_SIZEOF_CLOSURE(5)], *ka = kab, k2,
         size, negp;
  
  if (C_bignum_negativep(x)) {
    if (C_bignum_negativep(y)) {
      negp = C_mk_bool(op == C_fix(0) || op == C_fix(1)); /* and / ior */
      size = C_fix(nmax(C_bignum_size(x) + 1, C_bignum_size(y) + 1));
      k2 = C_closure(&ka, 5, (C_word)bignum_negneg_bitwise_op, k, op, x, y);
    } else {
      negp = C_mk_bool(op == C_fix(1) || op == C_fix(2)); /* ior / xor */
      size = C_fix(nmax(C_bignum_size(y), C_bignum_size(x) + 1)); /*!*/
      k2 = C_closure(&ka, 5, (C_word)bignum_posneg_bitwise_op, k, op, y, x);
    }
  } else {
    if (C_bignum_negativep(y)) {
      negp = C_mk_bool(op == C_fix(1) || op == C_fix(2)); /* ior / xor */
      size = C_fix(nmax(C_bignum_size(x), C_bignum_size(y) + 1));
      k2 = C_closure(&ka, 5, (C_word)bignum_posneg_bitwise_op, k, op, x, y);
    } else {
      negp = C_SCHEME_FALSE;
      size = C_fix(nmax(C_bignum_size(x), C_bignum_size(y)));
      k2 = C_closure(&ka, 5, (C_word)bignum_pospos_bitwise_op, k, op, x, y);
    }
  }

  C_allocate_bignum(5, (C_word)NULL, k2, size, negp, C_SCHEME_FALSE);
}

static void
bignum_pospos_bitwise_op(C_word c, C_word self, C_word result)
{
  C_word k = C_block_item(self, 1),
         op = C_block_item(self, 2),
         arg1 = C_block_item(self, 3),
         arg2 = C_block_item(self, 4);
  C_uword *scanr = C_bignum_digits(result),
          *endr = scanr + C_bignum_size(result),
          *scan1 = C_bignum_digits(arg1),
          *end1 = scan1 + C_bignum_size(arg1),
          *scan2 = C_bignum_digits(arg2),
          *end2 = scan2 + C_bignum_size(arg2),
          digit1, digit2;

  while (scanr < endr) {
    digit1 = (scan1 < end1) ? *scan1++ : 0;
    digit2 = (scan2 < end2) ? *scan2++ : 0;
    *scanr++ = (op == C_fix(0)) ? digit1 & digit2 :
               (op == C_fix(1)) ? digit1 | digit2 :
                                  digit1 ^ digit2;
  }
  C_kontinue(k, C_bignum_simplify(result));
}

static void
bignum_posneg_bitwise_op(C_word c, C_word self, C_word result)
{
  C_word k = C_block_item(self, 1),
         op = C_block_item(self, 2),
         arg1 = C_block_item(self, 3),
         arg2 = C_block_item(self, 4);
  C_uword *scanr = C_bignum_digits(result),
          *endr = scanr + C_bignum_size(result),
          *scan1 = C_bignum_digits(arg1),
          *end1 = scan1 + C_bignum_size(arg1),
          *scan2 = C_bignum_digits(arg2),
          *end2 = scan2 + C_bignum_size(arg2),
          digit1, digit2, carry2 = 1;

  while (scanr < endr) {
    digit1 = (scan1 < end1) ? *scan1++ : 0;
    digit2 = (~((scan2 < end2) ? *scan2++ : 0) & C_BIGNUM_DIGIT_MASK) + carry2;

    carry2 = digit2 >> C_BIGNUM_DIGIT_LENGTH;
    
    *scanr++ = ((op == C_fix(0)) ? digit1 & digit2 :
		(op == C_fix(1)) ? digit1 | digit2 :
                                   digit1 ^ digit2) & C_BIGNUM_DIGIT_MASK;
  }

  bignum_maybe_negate_magnitude(k, result);
}

static void
bignum_negneg_bitwise_op(C_word c, C_word self, C_word result)
{
  C_word k = C_block_item(self, 1),
         op = C_block_item(self, 2),
         arg1 = C_block_item(self, 3),
         arg2 = C_block_item(self, 4);
  C_uword *scanr = C_bignum_digits(result),
          *endr = scanr + C_bignum_size(result),
          *scan1 = C_bignum_digits(arg1),
          *end1 = scan1 + C_bignum_size(arg1),
          *scan2 = C_bignum_digits(arg2),
          *end2 = scan2 + C_bignum_size(arg2),
          digit1, digit2, carry1 = 1, carry2 = 1;

  while (scanr < endr) {
    digit1 = (~((scan1 < end1) ? *scan1++ : 0) & C_BIGNUM_DIGIT_MASK) + carry1;
    digit2 = (~((scan2 < end2) ? *scan2++ : 0) & C_BIGNUM_DIGIT_MASK) + carry2;

    carry1 = digit1 >> C_BIGNUM_DIGIT_LENGTH;
    carry2 = digit2 >> C_BIGNUM_DIGIT_LENGTH;

    *scanr++ = ((op == C_fix(0)) ? digit1 & digit2 :
		(op == C_fix(1)) ? digit1 | digit2 :
                                   digit1 ^ digit2) & C_BIGNUM_DIGIT_MASK;
  }

  bignum_maybe_negate_magnitude(k, result);
}

static void
bignum_maybe_negate_magnitude(C_word k, C_word result)
{
  /* XXX TODO: Use bignum_minus or bignum_negate_after_shift */
  if (C_bignum_negativep(result)) {
    C_uword *scan, *end, digit, carry;

    scan = C_bignum_digits(result);
    end = scan + C_bignum_size(result);
    carry = 1;

    while (scan < end) {
      digit = (~*scan & C_BIGNUM_DIGIT_MASK) + carry;
      carry = digit >> C_BIGNUM_DIGIT_LENGTH;
      *scan++ = digit & C_BIGNUM_DIGIT_MASK;
    }
  }
  C_kontinue(k, C_bignum_simplify(result));
}

/* This is ugly but really cleans up the code below */
#define RETURN_Q_AND_OR_R(calc_q, calc_r)                 \
  if (C_truep(C_and(return_q, return_r))) {               \
    C_values(4, C_SCHEME_UNDEFINED, k, calc_q, calc_r);   \
  } else if (C_truep(return_r)) {                         \
    C_kontinue(k, calc_r);                                \
  } else {                                                \
    C_kontinue(k, calc_q);                                \
  }

static C_regparm void
basic_divrem(C_word c, C_word self, C_word k, C_word loc, C_word x, C_word y, C_word return_q, C_word return_r)
{
  C_word ab[nmax(/* C_SIZEOF_FIX_BIGNUM, */ C_SIZEOF_FLONUM * 3,
                 C_SIZEOF_CLOSURE(7))], *a = ab, k2;

  if (x & C_FIXNUM_BIT) {
    if (y & C_FIXNUM_BIT) {
      RETURN_Q_AND_OR_R(C_a_u_i_fixnum_quotient_checked_loc(&a, 3, loc, x, y),
                        C_u_i_fixnum_remainder_checked_loc(loc, x, y));
    } else if (C_immediatep(y)) {
      barf(C_BAD_ARGUMENT_TYPE_NO_INTEGER_ERROR, C_strloc(loc), y);
    } else if (C_block_header(y) == C_FLONUM_TAG) {
      x = C_a_i_fix_to_flo(&a, 1, x);
      RETURN_Q_AND_OR_R(C_a_i_flonum_quotient_checked_loc(&a, 3, loc, x, y),
                        C_a_i_flonum_remainder_checked_loc(&a, 3, loc, x, y));
    } else if (C_IS_BIGNUM_TYPE(y)) {
      integer_divrem(7, (C_word)NULL, k, loc, x, y, return_q, return_r);
    } else {
      barf(C_BAD_ARGUMENT_TYPE_NO_INTEGER_ERROR, C_strloc(loc), y);
    }
  } else if (C_immediatep(x)) {
    barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, C_strloc(loc), x);
  } else if (C_block_header(x) == C_FLONUM_TAG) {
    if (y & C_FIXNUM_BIT) {
      y = C_a_i_fix_to_flo(&a, 1, y);
      RETURN_Q_AND_OR_R(C_a_i_flonum_quotient_checked_loc(&a, 3, loc, x, y),
                        C_a_i_flonum_remainder_checked_loc(&a, 3, loc, x, y));
    } else if (C_immediatep(y)) {
      barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, C_strloc(loc), y);
    } else if (C_block_header(y) == C_FLONUM_TAG) {
      RETURN_Q_AND_OR_R(C_a_i_flonum_quotient_checked_loc(&a, 3, loc, x, y),
                        C_a_i_flonum_remainder_checked_loc(&a, 3, loc, x, y));
    } else if (C_IS_BIGNUM_TYPE(y)) {
      k2 = C_closure(&a, 7, (C_word)divrem_intflo,
                     k, loc, C_SCHEME_TRUE, y, return_q, return_r);
      C_u_flo_to_int(4, (C_word)NULL, k2, loc, x);
    } else {
      barf(C_BAD_ARGUMENT_TYPE_NO_INTEGER_ERROR, C_strloc(loc), y);
    }
  } else if (C_IS_BIGNUM_TYPE(x)) {
    if (y & C_FIXNUM_BIT) {
      integer_divrem(7, (C_word)NULL, k, loc, x, y, return_q, return_r);
    } else if (C_immediatep(y)) {
      barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, C_strloc(loc), y);
    } else if (C_block_header(y) == C_FLONUM_TAG) {
      k2 = C_closure(&a, 7, (C_word)divrem_intflo,
                     k, loc, C_SCHEME_FALSE, x, return_q, return_r);
      C_u_flo_to_int(4, (C_word)NULL, k2, loc, y);
    } else if (C_IS_BIGNUM_TYPE(y)) {
      bignum_divrem(6, (C_word)NULL, k, x, y, return_q, return_r);
    } else {
      barf(C_BAD_ARGUMENT_TYPE_NO_INTEGER_ERROR, C_strloc(loc), y);
    }
  } else {
    barf(C_BAD_ARGUMENT_TYPE_NO_INTEGER_ERROR, C_strloc(loc), x);
  }
}

/* TODO: We can get rid of the first *_intflo by rolling it into one and
 * creating the closure at the call site.
 */
static void divrem_intflo(C_word c, C_word self, C_word intnum)
{
  C_word k = C_block_item(self, 1),
         loc = C_block_item(self, 2),
         intnum_is_x =  C_block_item(self, 3),
         other_arg = C_block_item(self, 4),
         return_q = C_block_item(self, 5),
         return_r = C_block_item(self, 6),
         kab[C_SIZEOF_CLOSURE(2)], *ka = kab, k2;
  
  k2 = C_closure(&ka, 2, (C_word)divrem_intflo_2, k);
  if (C_truep(intnum_is_x))
    integer_divrem(7, (C_word)NULL, k2, loc, intnum, other_arg,
                   return_q, return_r);
  else
    integer_divrem(7, (C_word)NULL, k2, loc, other_arg, intnum,
                   return_q, return_r);
}

static void divrem_intflo_2(C_word c, C_word self, ...)
{
  C_word k = C_block_item(self, 1),
         ab[C_SIZEOF_FLONUM * 2], *a = ab, x, y;
  va_list v;

  va_start(v, self);
  if (c == 2) {
    x = va_arg(v, C_word);
    va_end(v);
    if (x & C_FIXNUM_BIT) x = C_a_i_fix_to_flo(&a, 1, x);
    else x = C_a_u_i_big_to_flo(&a, 1, x);
    C_kontinue(k, x);
  } else { /* c == 3 */
    x = va_arg(v, C_word);
    y = va_arg(v, C_word);
    va_end(v);

    if (x & C_FIXNUM_BIT) x = C_a_i_fix_to_flo(&a, 1, x);
    else x = C_a_u_i_big_to_flo(&a, 1, x);
    if (y & C_FIXNUM_BIT) y = C_a_i_fix_to_flo(&a, 1, y);
    else y = C_a_u_i_big_to_flo(&a, 1, y);
    C_values(4, C_SCHEME_UNDEFINED, k, x, y);
  }
}

static void bignum_divrem_fixnum_2(C_word c, C_word self, C_word negated_big)
{
   C_word k = C_block_item(self, 1),
          return_q = C_block_item(self, 2),
          return_r = C_block_item(self, 3);
   RETURN_Q_AND_OR_R(negated_big, C_fix(0));
}

static C_regparm void
integer_divrem(C_word c, C_word self, C_word k, C_word loc, C_word x, C_word y, C_word return_q, C_word return_r)
{
  if (!(y & C_FIXNUM_BIT)) { /* y is bignum. */
    if (x & C_FIXNUM_BIT) {
      /* abs(x) < abs(y), so it will always be [0, x] except for this case: */
      if (x == C_fix(C_MOST_NEGATIVE_FIXNUM) &&
          C_bignum_negated_fitsinfixnump(y)) {
	RETURN_Q_AND_OR_R(C_fix(-1), C_fix(0));
      } else {
	RETURN_Q_AND_OR_R(C_fix(0), x);
      }
    } else {
      bignum_divrem(4, (C_word)NULL, k, x, y, return_q, return_r);
    }
  } else if (x & C_FIXNUM_BIT) { /* both x and y are fixnum. */
    C_word ab[C_SIZEOF_FIX_BIGNUM], *a = ab;
    RETURN_Q_AND_OR_R(C_a_u_i_fixnum_quotient_checked_loc(&a, 3, loc, x, y),
                      C_u_i_fixnum_remainder_checked_loc(loc, x, y));
  } else { /* x is bignum, y is fixnum. */
    C_word absy = (y < 0) ? -C_unfix(y) : C_unfix(y);
    int ylen = C_ilen(absy);

    if (y == C_fix(1)) {
      RETURN_Q_AND_OR_R(x, C_fix(0));
    } else if (y == C_fix(0)) {
      C_div_by_zero_error(C_strloc(loc));
    } else if (y == C_fix(-1)) {
      C_word kab[C_SIZEOF_CLOSURE(4)], *ka = kab, k2;
      k2 = C_closure(&ka, 4, (C_word)bignum_divrem_fixnum_2,
                     k, return_q, return_r);
      C_u_bignum_negate(3, (C_word)NULL, k2, x);
    } else if (C_fitsinbignumhalfdigitp(absy) ||
               ((ylen < C_BIGNUM_DIGIT_LENGTH) &&
                (((C_uword)1 << ylen-1) == absy))) {
      if (C_truep(return_q)) {
        C_word q_negp = C_mk_bool((y < 0) ?
                                  !(C_bignum_negativep(x)) :
                                  C_bignum_negativep(x)),
                r_negp = C_mk_bool(C_bignum_negativep(x)),
                kab[C_SIZEOF_BIGNUM(2)+C_SIZEOF_CLOSURE(9)], *ka = kab, k2, size;
  
        size = C_fix(C_bignum_size(x));
        k2 = C_closure(&ka, 7,
                       (C_word)bignum_destructive_divide_unsigned_small,
                       k, x, C_fix(absy),
                       return_q, return_r, C_SCHEME_FALSE);
        C_allocate_bignum(5, (C_word)NULL, k2, size, q_negp, C_SCHEME_FALSE);
      } else {
        C_word rem;
	C_uword next_power = (C_uword)1 << (C_ilen(absy)-1);

	if (next_power == absy) { /* Is absy a power of two? */
          rem = *(C_bignum_digits(x)) & (next_power - 1);
        } else { /* Too bad, we have to do some real work */
          rem = bignum_remainder_unsigned_halfdigit(x, absy);
	}
        C_kontinue(k, C_bignum_negativep(x) ? C_fix(-rem) : C_fix(rem));
      }
    } else {			/* Just divide it as two bignums */
      C_word ab[C_SIZEOF_FIX_BIGNUM], *a = ab;
      bignum_divrem(6, (C_word)NULL, k, x, C_a_u_i_fix_to_big(&a, y),
                    return_q, return_r);
    }
  }
}

static C_regparm void
bignum_divrem(C_word c, C_word self, C_word k, C_word x, C_word y, C_word return_q, C_word return_r)
{
  C_word kab[C_SIZEOF_FIX_BIGNUM+C_SIZEOF_CLOSURE(9)], *ka = kab, k2, size,
         q_negp = C_mk_bool(C_bignum_negativep(y) ?
                            !C_bignum_negativep(x) :
                            C_bignum_negativep(x)),
         r_negp = C_mk_bool(C_bignum_negativep(x));

  switch(bignum_cmp_unsigned(x, y)) {
  case 0:
    RETURN_Q_AND_OR_R(C_truep(q_negp) ? C_fix(-1) : C_fix(1), C_fix(0));
  case -1:
    RETURN_Q_AND_OR_R(C_fix(0), x);
  case 1:
  default:
    if (C_truep(return_q)) {
      k2 = C_closure(&ka, 9, (C_word)bignum_divide_2_unsigned, k, x, y,
                     return_q, return_r, r_negp,
                     /* Will be filled in later */
                     C_SCHEME_UNDEFINED, C_SCHEME_UNDEFINED);
      size = C_fix(C_bignum_size(x) + 1 - C_bignum_size(y));
      C_allocate_bignum(5, (C_word)NULL, k2, size, q_negp, C_SCHEME_FALSE);
    } else { /* We can skip bignum_divide_2_unsigned if we need no quotient */
      k2 = C_closure(&ka, 9, (C_word)bignum_divide_2_unsigned_2, k, x, y,
                     return_q, return_r, r_negp,
                     /* Will be filled in later */
                     C_SCHEME_UNDEFINED, C_SCHEME_UNDEFINED);
      size = C_fix(C_bignum_size(x) + 1); /* May need to be normalized */
      C_allocate_bignum(5, (C_word)NULL, k2, size, r_negp, C_SCHEME_FALSE);
    }
  }
}

static C_word
bignum_remainder_unsigned_halfdigit(C_word num, C_word den)
{
  C_uword *start = C_bignum_digits(num),
          *scan = start + C_bignum_size(num),
          rem = 0, two_digits;

  assert((den > 1) && (C_fitsinbignumhalfdigitp(den)));
  while (start < scan) {
    two_digits = (*--scan);
    rem = C_BIGNUM_DIGIT_COMBINE(rem, C_BIGNUM_DIGIT_HI_HALF(two_digits)) % den;
    rem = C_BIGNUM_DIGIT_COMBINE(rem, C_BIGNUM_DIGIT_LO_HALF(two_digits)) % den;
  }
  return rem;
}

/* External interface for the above internal divrem functions */
void C_ccall
C_basic_divrem(C_word c, C_word self, C_word k, C_word loc, C_word x, C_word y)
{
  basic_divrem(7, (C_word)NULL, k, loc, x, y, C_SCHEME_TRUE, C_SCHEME_TRUE);
}

void C_ccall
C_u_integer_divrem(C_word c, C_word self, C_word k, C_word loc, C_word x, C_word y)
{
  integer_divrem(7, (C_word)NULL, k, loc, x, y, C_SCHEME_TRUE, C_SCHEME_TRUE);
}

void C_ccall
C_u_bignum_divrem(C_word c, C_word self, C_word k, C_word x, C_word y)
{
  bignum_divrem(6, (C_word)NULL, k, x, y, C_SCHEME_TRUE, C_SCHEME_TRUE);
}

void C_ccall
C_basic_remainder(C_word c, C_word self, C_word k, C_word loc, C_word x, C_word y)
{
  basic_divrem(7, (C_word)NULL, k, loc, x, y, C_SCHEME_FALSE, C_SCHEME_TRUE);
}

void C_ccall
C_u_integer_remainder(C_word c, C_word self, C_word k, C_word loc, C_word x, C_word y)
{
  integer_divrem(7, (C_word)NULL, k, loc, x, y, C_SCHEME_FALSE, C_SCHEME_TRUE);
}

void C_ccall
C_u_bignum_remainder(C_word c, C_word self, C_word k, C_word x, C_word y)
{
  bignum_divrem(6, (C_word)NULL, k, x, y, C_SCHEME_FALSE, C_SCHEME_TRUE);
}

void C_ccall
C_basic_quotient(C_word c, C_word self, C_word k, C_word loc, C_word x, C_word y)
{
  basic_divrem(7, (C_word)NULL, k, loc, x, y, C_SCHEME_TRUE, C_SCHEME_FALSE);
}

void C_ccall
C_u_integer_quotient(C_word c, C_word self, C_word k, C_word loc, C_word x, C_word y)
{
  integer_divrem(7, (C_word)NULL, k, loc, x, y, C_SCHEME_TRUE, C_SCHEME_FALSE);
}

void C_ccall
C_u_bignum_quotient(C_word c, C_word self, C_word k, C_word x, C_word y)
{
  bignum_divrem(6, (C_word)NULL, k, x, y, C_SCHEME_TRUE, C_SCHEME_FALSE);
}

/* "small" is either a number that fits a halfdigit, or a power of two */
static void
bignum_destructive_divide_unsigned_small(C_word c, C_word self, C_word quotient)
{
  C_word k = C_block_item(self, 1),
         numerator = C_block_item(self, 2),
         denominator = C_unfix(C_block_item(self, 3)),
         /* return_quotient = C_block_item(self, 4), */
         return_remainder = C_block_item(self, 5),
         remainder_negp = C_block_item(self, 6);
  C_uword *start = C_bignum_digits(quotient),
          *end = start + C_bignum_size(quotient),
          remainder;
  int shift_amount;

  bignum_digits_destructive_copy(quotient, numerator);

  shift_amount = C_ilen(denominator)-1;
  if (((C_uword)1 << shift_amount) == denominator) { /* Power of two?  Shift! */
    remainder = bignum_digits_destructive_shift_right(start, end, shift_amount);
    assert(C_ufitsinfixnump(remainder));
  } else {
    remainder = bignum_digits_destructive_scale_down(start, end, denominator);
    assert(C_fitsinbignumhalfdigitp(remainder));
  }

  quotient = C_bignum_simplify(quotient);

  if (C_truep(return_remainder)) {
    remainder = C_truep(remainder_negp) ? -remainder : remainder;
    C_values(4, C_SCHEME_UNDEFINED, k, quotient, C_fix(remainder));
  } else {
    C_kontinue(k, quotient);
  }
}


/* This is used instead of bignum_digits_destructive_shift_right so
 * that we don't have to copy and then traverse the destination again.
 */
static void
bignum_destructive_normalize(C_word target, C_word source, int shift_left)
{
  C_uword digit, carry = 0,
          *scan_source = C_bignum_digits(source),
          *scan_target = C_bignum_digits(target),
          *end_source = scan_source + C_bignum_size(source),
          *end_target = scan_target + C_bignum_size(target);
  int shift_right = C_BIGNUM_DIGIT_LENGTH - shift_left;
  C_uword mask = (1L << shift_right) - 1;

  while (scan_source < end_source) {
    digit = (*scan_source++);
    (*scan_target++) = (((digit & mask) << shift_left) | carry);
    carry = (digit >> shift_right);
  }
  if (scan_target < end_target)
    (*scan_target) = carry;
  else
    assert(carry == 0);
}


/* Full bignum division */

static void
bignum_divide_2_unsigned(C_word c, C_word self, C_word quotient)
{
  C_word numerator = C_block_item(self, 2),
         remainder_negp = C_block_item(self, 6),
	 size = C_fix(C_bignum_size(numerator) + 1);

  /* Nice: We can recycle the current closure */
  C_set_block_item(self, 0, (C_word)bignum_divide_2_unsigned_2);
  C_set_block_item(self, 7, quotient);
  C_allocate_bignum(5, (C_word)NULL, self, size, remainder_negp, C_SCHEME_FALSE);
}

/* For help understanding this algorithm, see:
   Knuth, Donald E., "The Art of Computer Programming",
   volume 2, "Seminumerical Algorithms"
   section 4.3.1, "Multiple-Precision Arithmetic".

   [Yeah, that's a nice book but that particular section is not
   helpful at all, which is also pointed out by P. Brinch Hansen's
   "Multiple-Length Division Revisited: A Tour Of The Minefield".
   That's a more down-to-earth step-by-step explanation of the
   algorithm.  Add to this the C implementation in Hacker's Delight
   (section 9-2, p141--142) and you may be able to grok this...
   ...barely, if you're as math-challenged as I am -- sjamaan]
*/

static void
bignum_divide_2_unsigned_2(C_word c, C_word self, C_word remainder)
{
  C_word k = C_block_item(self, 1),
         numerator = C_block_item(self, 2),
         denominator = C_block_item(self, 3),
         return_quotient = C_block_item(self, 4),
         return_remainder = C_block_item(self, 5),
         /* This one may be overwritten with the remainder */
         /* remainder_negp = C_block_item(self, 6), */
         quotient = C_block_item(self, 7),
	 length = C_bignum_size(denominator);
  C_uword d1 = *(C_bignum_digits(denominator) + length - 1);
  int shift;

  shift = C_BIGNUM_DIGIT_LENGTH - C_ilen(d1); /* nlz */

  /* We have to work on halfdigits, so we shift out only the necessary
   * amount in order fill out that halfdigit (base is halved).
   * This trick is shamelessly stolen from Gauche :)
   * See below for part 2 of the trick.
   */
  if (shift >= C_BIGNUM_HALF_DIGIT_LENGTH)
    shift -= C_BIGNUM_HALF_DIGIT_LENGTH;

  /* Code below won't always set high halfdigit of quotient, so do it here. */
  if (quotient != C_SCHEME_UNDEFINED)
    C_bignum_digits(quotient)[C_bignum_size(quotient)-1] = 0;

  if (shift == 0) { /* Already normalized */
    bignum_digits_destructive_copy(remainder, numerator);
    length = C_bignum_size(numerator);
    C_bignum_digits(remainder)[length] = 0; /* Initialize highest digit */

    bignum_destructive_divide_normalized(remainder, denominator, quotient);
  } else { /* Requires normalisation of denominator, allocate tmp bignum */
    C_uword *startr = C_bignum_digits(remainder),
            *endr = startr + C_bignum_size(remainder);
    C_word tmp_big;
    tmp_big = allocate_tmp_bignum(C_fix(length), C_SCHEME_FALSE, C_SCHEME_FALSE);

    bignum_destructive_normalize(remainder, numerator, shift);
    bignum_destructive_normalize(tmp_big, denominator, shift);
    bignum_destructive_divide_normalized(remainder, tmp_big, quotient);
    bignum_digits_destructive_shift_right(startr, endr, shift);

    free_tmp_bignum(tmp_big);
  }

  if (C_truep(return_remainder)) {
    if (C_truep(return_quotient)) {
      C_values(4, C_SCHEME_UNDEFINED, k,
               C_bignum_simplify(quotient), C_bignum_simplify(remainder));
    } else {
      C_kontinue(k, C_bignum_simplify(remainder));
    }
  } else {
    assert(C_truep(return_quotient));
    C_kontinue(k, C_bignum_simplify(quotient));
  }
}

static void
bignum_destructive_divide_normalized(C_word big_u, C_word big_v, C_word big_q)
{
  C_uword *v = C_bignum_digits(big_v),
          *u = C_bignum_digits(big_u),
          *q = big_q == C_SCHEME_UNDEFINED ? NULL : C_bignum_digits(big_q),
           p,               /* product of estimated quotient & "denominator" */
           hat, qhat, rhat, /* estimated quotient and remainder digit */
           vn_1, vn_2;      /* "cached" values v[n-1], v[n-2] */
  C_word t, k;              /* Two helpers: temp/final remainder and "borrow" */
  /* We use plain ints here, which theoretically may not be enough on
   * 64-bit for an insanely huge number, but it is a _lot_ faster.
   */
  int n = C_bignum_size(big_v) * 2,       /* in halfwords */
      m = (C_bignum_size(big_u) * 2) - 2; /* Correct for extra digit */
  int i, j;		   /* loop  vars */

  /* TODO: If C_LITTLE_ENDIAN, we can just access the halfdigit directly,
     after we've changed the representation of digits to use the full word */
  
  /* Access the halfdigit in number x at position p (counting in halfdigits)
   * This is a bit of a mindfuck, because it's little endian all the way:
   * n[0] is really the low half of digit 0, n[1] the high half of digit 0,
   * n[2] is the low half of digit 1, etc.
   */
#define HALF_DIGIT_AT(x, p) \
  ((p) & 1 ? C_BIGNUM_DIGIT_HI_HALF((x)[(p)>>1]) \
   : C_BIGNUM_DIGIT_LO_HALF((x)[(p)>>1]))

  /* Store a halfdigit in x at position p (counting in halfdigits) */
#define STORE_HALF_DIGIT_AT(x, p, d) \
  (x)[(p)>>1] = ((p) & 1 ? \
                C_BIGNUM_DIGIT_COMBINE(((d) & C_BIGNUM_HALF_DIGIT_MASK), \
                                       C_BIGNUM_DIGIT_LO_HALF((x)[(p)>>1])) \
                : C_BIGNUM_DIGIT_COMBINE(C_BIGNUM_DIGIT_HI_HALF((x)[(p)>>1]), \
                                         ((d) & C_BIGNUM_HALF_DIGIT_MASK)))

  /* Part 2 of Gauche's aforementioned trick: */
  if (HALF_DIGIT_AT(v, n-1) == 0) n--;

  /* These won't change during the loop, but are used in every step. */
  vn_1 = HALF_DIGIT_AT(v, n-1);
  vn_2 = HALF_DIGIT_AT(v, n-2);

  /* See also Hacker's Delight, Figure 9-1.  This is almost exactly that. */
  for (j = m - n; j >= 0; j--) {
    hat = C_BIGNUM_DIGIT_COMBINE(HALF_DIGIT_AT(u,j+n), HALF_DIGIT_AT(u,j+n-1));
    qhat = hat / vn_1;
    rhat = hat % vn_1;

    /* Two whiles is faster than one big check with an OR.  Thanks, Gauche! */
    while(qhat >= (1L << C_BIGNUM_HALF_DIGIT_LENGTH)) { qhat--; rhat += vn_1; }
    while(qhat * vn_2 > C_BIGNUM_DIGIT_COMBINE(rhat, HALF_DIGIT_AT(u,j+n-2))
	  && rhat < (1L << C_BIGNUM_HALF_DIGIT_LENGTH)) {
      qhat--;
      rhat += vn_1;
    }

    /* Multiply and subtract */
    k = 0;
    for (i = 0; i < n; i++) {
      p = qhat * HALF_DIGIT_AT(v, i);
      t = HALF_DIGIT_AT(u,i+j) - k - (p & C_BIGNUM_HALF_DIGIT_MASK);
      STORE_HALF_DIGIT_AT(u, i+j, t);
      k = (p >> C_BIGNUM_HALF_DIGIT_LENGTH) - (t >> C_BIGNUM_HALF_DIGIT_LENGTH);
    }
    t = HALF_DIGIT_AT(u,j+n) - k;
    STORE_HALF_DIGIT_AT(u, j+n, t);

    if (t < 0) {		/* Subtracted too much? */
      qhat--;
      k = 0;
      for (i = 0; i < n; i++) {
        t = HALF_DIGIT_AT(u, i+j) + HALF_DIGIT_AT(v, i) + k;
        STORE_HALF_DIGIT_AT(u, i+j, t);
	k = t >> C_BIGNUM_HALF_DIGIT_LENGTH;
      }
      STORE_HALF_DIGIT_AT(u, j+n, (HALF_DIGIT_AT(u, j+n) + k));
    }
    if (q != NULL) STORE_HALF_DIGIT_AT(q, j, qhat);
  } /* end j */
#undef STORE_HALF_DIGIT_AT
#undef HALF_DIGIT_AT
}