/* 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 */

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 bignum_digits_destructive_scale_up_with_carry(C_word *start, C_word *end, C_word fix_factor, C_word carry);
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 void cmp_intflo(C_word c, C_word self, C_word x);
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 gcd_intflo(C_word c, C_word self, C_word intnum) C_noret;
static void gcd_intflo_2(C_word c, C_word self, C_word result) C_noret;
static void integer_gcd_2(C_word c, C_word self, C_word new_y) C_noret;
static void integer_gcd_3(void *dummy) C_noret;
static void bignum_gcd_loop(C_word c, C_word self, C_word tmp_x) C_noret;
static void bignum_gcd_loop_2(C_word c, C_word self, C_word tmp_y) 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 working_copy) C_noret;
static void bignum_to_digits_3(C_word c, C_word self, C_word string) C_noret;
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_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 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_word x, C_word y) 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 quotient_intflo(C_word c, C_word self, C_word intnum) C_noret;
static void quotient_intflo_2(C_word c, C_word self, C_word x) C_noret;
static void remainder_intflo(C_word c, C_word self, C_word intnum) C_noret;
static void remainder_intflo_2(C_word c, C_word self, C_word x) C_noret;
static void bignum_destructive_normalize(C_word target, C_word source, C_word shift_left);
static C_word bignum_remainder_unsigned_halfdigit(C_word num, C_word den);
static void bignum_destructive_divide_unsigned_halfdigit(C_word c, C_word self, C_word quotient);
static C_word bignum_divide_digit(C_word uh, C_word ul, C_word v, C_word *q);
static C_word bignum_divide_and_subtract_digit(C_word v1, C_word v2, C_word guess, C_word *u);
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_divide_2_unsigned_3(C_word c, C_word self, C_word tmp_big) C_noret;
static void bignum_destructive_divide_normalized(C_word u, C_word v, C_word q);
static C_word bignum_divide_and_subtract(C_word *v_start, C_word *v_end, C_word guess, C_word *u_start);
static C_word bignum_simplify_shifted(C_word bignum, C_word shift_right);

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);
  }
}

/* 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)) {
    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),
         *scan_x = C_bignum_digits(x),
	 *end_x = scan_x + C_bignum_size(x),
         *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, carry = 0;

  /* Move over the two numbers simultaneously, adding digits w/ carry. */
  while (scan_y < end_y) {
    sum = (*scan_x++) + (*scan_y++) + carry;
    if (C_fitsinbignumdigitp(sum)) {
      (*scan_r++) = sum;
      carry = 0;
    } else {
      (*scan_r++) = sum & C_BIGNUM_DIGIT_MASK;
      carry = 1;
    }
  }
  
  /* The end of y, the smaller number.  Propagate carry into the rest of x. */
  if (carry) {
    while (scan_x < end_x) {
      sum = (*scan_x++) + 1;
      if (C_fitsinbignumdigitp(sum)) {
        (*scan_r++) = sum;
        carry = 0;
        break;
      } else {
        (*scan_r++) = sum & C_BIGNUM_DIGIT_MASK;
      }
    }
  }

  if (carry) { /* We must've reached the end of x, with still a carry. */
    (*scan_r) = 1; /* No need to trim: we're now using the extra digit. */
    /* No need to normalize: We started with a bignum and it only grew. */
    C_kontinue(k, result);
  } else {
    /* No more carry.  Copy remaining part of x (if any) to result. */
    while (scan_x < end_x)
      (*scan_r++) = (*scan_x++);

    assert(scan_r == end_r - 1);

    *scan_r = 0;	/* Ensure simplify() can do the right thing */
    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_word *startx = C_bignum_digits(x);
    C_word *scanx = startx + xlen;
    C_word *scany = C_bignum_digits(y) + ylen;

    while (startx < scanx) {
      C_word xdigit = (*--scanx);
      C_word 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),
         *scan_x = C_bignum_digits(x),
         *end_x = scan_x + C_bignum_size(x),
         *scan_r = C_bignum_digits(result),
         *scan_y = C_bignum_digits(y),
         *end_y = scan_y + C_bignum_size(y),
         difference, borrow = 0;

  /* Move over the two numbers simultaneously, subtracting digits w/ borrow. */
  while (scan_y < end_y) {
    difference = (((*scan_x++) - (*scan_y++)) - borrow);
    if (difference < 0) {
      (*scan_r++) = ((C_word)1 << C_BIGNUM_DIGIT_LENGTH) + difference;
      borrow = 1;
    } else {
      (*scan_r++) = difference;
      borrow = 0;
    }
  }

  /* The end of y, the smaller number.  Propagate borrow into the rest of x. */
  if (borrow != 0) {
    while (scan_x < end_x) {
      difference = ((*scan_x++) - borrow);
      if (difference < 0) {
        (*scan_r++) = ((C_word)1 << C_BIGNUM_DIGIT_LENGTH) + difference;
      } else {
	(*scan_r++) = difference;
	borrow = 0;
	break;
      }
    }
  }

  assert(borrow == 0);

  /* Finishing up: Copy remaining part of x (if any) into result. */
  while (scan_x < end_x)
    (*scan_r++) = (*scan_x++);

  C_kontinue(k, C_bignum_simplify(result));
}

void C_ccall
C_2_basic_gcd(C_word c, C_word self, C_word k, C_word loc, C_word x, C_word y)
{
  C_word ab[C_SIZEOF_FLONUM*2+C_SIZEOF_CLOSURE(4)], *a = ab, k2;

  if (x & C_FIXNUM_BIT) {
    if (y & C_FIXNUM_BIT) {
      C_kontinue(k, C_u_i_2_fixnum_gcd(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) {
      C_kontinue(k, C_a_u_i_2_flonum_gcd(&a, 1, C_a_i_fix_to_flo(&a, 1, x), y));
    } else if (C_IS_BIGNUM_TYPE(y)) {
      C_u_2_integer_gcd(4, (C_word)NULL, k, x, y);
    } 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) {
      C_kontinue(k, C_a_u_i_2_flonum_gcd(&a, 1, x, C_a_i_fix_to_flo(&a, 1, 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_a_u_i_2_flonum_gcd(&a, 1, x, y));
    } else if (C_IS_BIGNUM_TYPE(y)) {
      k2 = C_closure(&a, 4, (C_word)gcd_intflo, k, C_SCHEME_TRUE, y);
      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) {
      C_u_2_integer_gcd(4, (C_word)NULL, k, 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) {
      k2 = C_closure(&a, 4, (C_word)gcd_intflo, k, C_SCHEME_FALSE, x);
      C_u_flo_to_int(4, (C_word)NULL, k2, loc, y);
    } else if (C_IS_BIGNUM_TYPE(y)) {
      C_u_2_bignum_gcd(4, (C_word)NULL, k, x, y);
    } 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);
  }
}

static void gcd_intflo(C_word c, C_word self, C_word intnum)
{
  C_word k = C_block_item(self, 1),
         intnum_is_x =  C_block_item(self, 2),
	 other_arg = C_block_item(self, 3),
	 kab[C_SIZEOF_CLOSURE(2)], *ka = kab, k2;
  
  k2 = C_closure(&ka, 2, (C_word)gcd_intflo_2, k);
  if (C_truep(intnum_is_x))
    C_u_2_integer_gcd(4, (C_word)NULL, k2, intnum, other_arg);
  else
    C_u_2_integer_gcd(4, (C_word)NULL, k2, other_arg, intnum);
}

static void gcd_intflo_2(C_word c, C_word self, C_word result)
{
   C_word k = C_block_item(self, 1), ab[C_SIZEOF_FLONUM], *a = ab;
   if (result & C_FIXNUM_BIT)
     C_kontinue(k, C_a_i_fix_to_flo(&a, 1, result));
   else
     C_kontinue(k, C_a_u_i_big_to_flo(&a, 1, 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_u_2_integer_gcd(C_word c, C_word self, C_word k, C_word x, C_word y)
{
  if (y == C_fix(0)) {
    C_u_integer_abs(3, (C_word)NULL, k, x);
  } else if (x & C_FIXNUM_BIT && y & C_FIXNUM_BIT) {
    C_kontinue(k, C_u_i_2_fixnum_gcd(x, y));
  } else if (!(x & C_FIXNUM_BIT) && !(y & C_FIXNUM_BIT)) {
    C_u_2_bignum_gcd(4, (C_word)NULL, k, x, y);
  } else {
    /* Choose the slow and simple path: recursive call.  This should
     * be invoked only a handful of times until we hit fixnums.
     */
    C_word kab[C_SIZEOF_CLOSURE(3)], *ka = kab, k2;

    k2 = C_closure(&ka, 3, (C_word)integer_gcd_2, k, y);
    /* Pass #f for "loc", we know we won't divide by zero */
    C_u_integer_remainder(5, (C_word)NULL, k2, C_SCHEME_FALSE, x, y);
  }
}

void C_ccall
C_u_2_bignum_gcd(C_word c, C_word self, C_word k, C_word x, C_word y)
{
  C_word kab[C_SIZEOF_CLOSURE(5)], *ka = kab, k2, size;

  switch(bignum_cmp_unsigned(x, y)) {
  case 0:
    C_kontinue(k, x);
  case -1:
    /* Swap to avoid extra step (division algorithm also requires this) */
    k2 = x;
    x = y;
    y = k2;
  case 1:
  default:
    /* Instead of recursively calling integer_gcd, it is much faster
     * to allocate two bignums and then just loop, destructively
     * updating them, until we reach a fixnum.
     */
    size = C_fix(C_bignum_size(x)+1); /* May need to be normalized */
    k2 = C_closure(&ka, 5, (C_word)bignum_gcd_loop, k, x, y, C_SCHEME_UNDEFINED);
    C_allocate_bignum(5, (C_word)NULL, k2, size, C_SCHEME_FALSE, C_SCHEME_FALSE);
  }
}

static void
integer_gcd_2(C_word c, C_word self, C_word new_y)
{
  if (!C_demand(5 + C_SIZEOF_CLOSURE(3))) { /* XXX */
    C_save_and_reclaim((void *)integer_gcd_3, (void *)integer_gcd_2,
                       2, new_y, self);
  } else {
    C_word k = C_block_item(self, 1),
           x = C_block_item(self, 2); /* Old y = new x */
    C_u_2_integer_gcd(4, (C_word)NULL, k, x, new_y);
  }
}

static void
integer_gcd_3(void *dummy)
{
   C_word self = C_restore,
	  new_y = C_restore;
   ((C_proc2)(void*)(*((C_word*)self+1)))(2, self, new_y);
}

static void
bignum_gcd_loop(C_word c, C_word self, C_word tmp_x)
{
  C_word x = C_block_item(self, 2),
         size = C_fix(C_bignum_size(x)+1); /* Will be swapped, so use x-len! */

  /* Nice: We can recycle the current closure */
  C_set_block_item(self, 0, (C_word)bignum_gcd_loop_2);
  C_set_block_item(self, 4, tmp_x);
  C_allocate_bignum(5, (C_word)NULL, self, size, C_SCHEME_FALSE, C_SCHEME_FALSE);
}

static void
bignum_gcd_loop_2(C_word c, C_word self, C_word tmp_y)
{
  C_word k = C_block_item(self, 1),
         x = C_block_item(self, 2),
         length_x = C_bignum_size(x),
         y = C_block_item(self, 3),
         length_y = C_bignum_size(y),
         tmp_x = C_block_item(self, 4), d1, shift;

  assert(length_x >= length_y);
  /* Because tmp_y is allocated as size(x)+1, we need to reset its length. */
  /* Mutate vector size of internal bignum vector for tmp_y */
  C_block_header(C_internal_bignum(tmp_y)) = (C_STRING_TYPE | C_wordstobytes(length_y+1));
  /* Set internal header. */
  C_bignum_header(tmp_y) = (C_bignum_header(tmp_y) & C_BIGNUM_HEADER_SIGN_BIT) | length_y;
    
  for(;;) {
    d1 = *(C_bignum_digits(y) + length_y - 1);
    shift = 0;

    /* TODO: Would it be possible to pull this out of the loop? */
    while (d1 < ((C_word)1 << (C_BIGNUM_DIGIT_LENGTH-1))) {
      d1 <<= 1;
      shift++;
    }
    /* The code below stores the remainder into tmp_x */
    if (shift == 0) { /* Already normalized? */
      if (tmp_x != x) { /* Avoid needless copying after first loop step. */
        bignum_digits_destructive_copy(tmp_x, x);
        *(C_bignum_digits(tmp_x) + length_x) = 0;
	/* This simplifies the swap below */
        bignum_digits_destructive_copy(tmp_y, y);
        *(C_bignum_digits(tmp_y) + length_y) = 0;
      }
      bignum_destructive_divide_normalized(tmp_x, y, C_SCHEME_UNDEFINED);
      tmp_x = C_bignum_simplify(tmp_x);
    } else {
      bignum_destructive_normalize(tmp_x, x, shift); /* OK even if tmp_x = x! */
      bignum_destructive_normalize(tmp_y, y, shift); /* OK even if tmp_y = y! */
      bignum_destructive_divide_normalized(tmp_x, tmp_y, C_SCHEME_UNDEFINED);
      tmp_x = bignum_simplify_shifted(tmp_x, shift);
      tmp_y = bignum_simplify_shifted(tmp_y, shift);
      assert(C_block_item(k, 0) != 0);
    }
    if (tmp_x & C_FIXNUM_BIT) {
      /* Finish up: Calculate fixnum/fixnum, bignum/fixnum, or just return x */
      C_u_2_integer_gcd(4, (C_word)NULL, k, tmp_y, tmp_x);
    } else {
      /* Update lengths to match the new values, so that we can stretch them */
      length_x = C_bignum_size(tmp_y);
      length_y = C_bignum_size(tmp_x);

      x = tmp_y;
      y = tmp_x;
      tmp_y = tmp_x;
      tmp_x = x;
      /* x and y are now their new values, sharing data with tmp_x and tmp_y! */

      /* Ensure that tmp_x is again 1 larger than x */
      /* Mutate vector size of internal bignum vector. */
      C_block_header(C_internal_bignum(tmp_x)) = (C_STRING_TYPE | C_wordstobytes(length_x+2));
      /* Set internal header. */
      C_bignum_header(tmp_x) = (C_bignum_header(tmp_x) & C_BIGNUM_HEADER_SIGN_BIT) | (length_x+1);
      *(C_bignum_digits(tmp_x) + length_x) = 0;
    }
  }
}

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);
}

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));
}

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_CLOSURE(5)+C_SIZEOF_FIX_BIGNUM], *a = ab, k2;

  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) {
      x = C_a_u_i_fix_to_big(&a, x); /* Continue below(1) */
    } 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) {
      y = C_a_u_i_fix_to_big(&a, y); /* Continue below(2) */
    } 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));
    }

    if (C_IS_BIGNUM_TYPE(y)) { /* (2) */
      if (!C_truep(C_u_i_fpintegerp(x))) {
        C_kontinue(k, C_SCHEME_FALSE);
      } else {
        k2 = C_closure(&a, 5, (C_word)cmp_intflo, k, C_fix(0), y, C_fix(0));
        C_u_flo_to_int(4, (C_word)NULL, k2, C_SCHEME_FALSE, x);
      }
    } else {
      try_extended_number("numbers#@extended-2-=", 3, k, x, y);
    }
  }

  if (C_IS_BIGNUM_TYPE(x)) { /* (1) */
    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) {
      if (!C_truep(C_u_i_fpintegerp(y))) {
        C_kontinue(k, C_SCHEME_FALSE);
      } else {
        k2 = C_closure(&a, 5, (C_word)cmp_intflo, k, C_fix(0), x, C_fix(0));
        C_u_flo_to_int(4, (C_word)NULL, k2, C_SCHEME_FALSE, y);
      }
    } 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_CLOSURE(5)+C_SIZEOF_FIX_BIGNUM+C_SIZEOF_FLONUM], *a = ab, k2;
  double f, i;

  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) {
      x = C_a_u_i_fix_to_big(&a, x); /* Continue below(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) {
      y = C_a_u_i_fix_to_big(&a, y); /* Continue below(2) */
    } 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));
    }

    if (C_IS_BIGNUM_TYPE(y)) { /* (2) */
      f = C_flonum_magnitude(x);
      if (C_isnan(f)) {
        C_kontinue(k, C_SCHEME_FALSE);
      } else if (C_isinf(f)) {
	C_kontinue(k, C_mk_bool(f < 0.0));
      } else {
	C_word diff;
        f = modf(f, &i);
        if (f < 0.0) diff = C_fix(-1);
        else if (f > 0.0) diff = C_fix(1);
        else diff = C_fix(0);
        k2 = C_closure(&a, 5, (C_word)cmp_intflo, k, C_fix(-1), y, diff);
        C_u_flo_to_int(4, (C_word)NULL, k2, C_SCHEME_FALSE, C_flonum(&a, i));
      }
    } else {
      try_extended_number("numbers#@extended-2-<", 4, k, loc, x, y);
    }
  }

  if (C_IS_BIGNUM_TYPE(x)) { /* (1) */
    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) {
      f = C_flonum_magnitude(y);
      if (C_isnan(f)) {
        C_kontinue(k, C_SCHEME_FALSE);
      } else if (C_isinf(f)) {
	C_kontinue(k, C_mk_bool(f > 0.0));
      } else {
	C_word diff;
        f = modf(f, &i);
        if (f < 0.0) diff = C_fix(-1);
        else if (f > 0.0) diff = C_fix(1);
        else diff = C_fix(0);
        k2 = C_closure(&a, 5, (C_word)cmp_intflo, k, C_fix(1), x, diff);
        C_u_flo_to_int(4, (C_word)NULL, k2, C_SCHEME_FALSE, C_flonum(&a, i));
      }
    } 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_CLOSURE(5)+C_SIZEOF_FIX_BIGNUM+C_SIZEOF_FLONUM], *a = ab, k2;
  double f, i;

  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) {
      x = C_a_u_i_fix_to_big(&a, x); /* Continue below(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) {
      y = C_a_u_i_fix_to_big(&a, y); /* Continue below(2) */
    } 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));
    }

    if (C_IS_BIGNUM_TYPE(y)) { /* (2) */
      f = C_flonum_magnitude(x);
      if (C_isnan(f)) {
        C_kontinue(k, C_SCHEME_FALSE);
      } else if (C_isinf(f)) {
	C_kontinue(k, C_mk_bool(f > 0.0));
      } else {
	C_word diff;
        f = modf(f, &i);
        if (f < 0.0) diff = C_fix(-1);
        else if (f > 0.0) diff = C_fix(1);
        else diff = C_fix(0);
        k2 = C_closure(&a, 5, (C_word)cmp_intflo, k, C_fix(1), y, diff);
        C_u_flo_to_int(4, (C_word)NULL, k2, C_SCHEME_FALSE, C_flonum(&a, i));
      }
    } else {
      try_extended_number("numbers#@extended-2->", 4, k, loc, x, y);
    }
  }

  if (C_IS_BIGNUM_TYPE(x)) { /* (1) */
    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) {
      f = C_flonum_magnitude(y);
      if (C_isnan(f)) {
        C_kontinue(k, C_SCHEME_FALSE);
      } else if (C_isinf(f)) {
	C_kontinue(k, C_mk_bool(f < 0.0));
      } else {
	C_word diff;
        f = modf(f, &i);
        if (f < 0.0) diff = C_fix(-1);
        else if (f > 0.0) diff = C_fix(1);
        else diff = C_fix(0);
        k2 = C_closure(&a, 5, (C_word)cmp_intflo, k, C_fix(-1), x, diff);
        C_u_flo_to_int(4, (C_word)NULL, k2, C_SCHEME_FALSE, C_flonum(&a, i));
      }
    } 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 void cmp_intflo(C_word c, C_word self, C_word x)
{
  C_word k = C_block_item(self, 1),
         comparator = C_block_item(self, 2),
         y = C_block_item(self, 3),
         diff = C_block_item(self, 4),
         ab[C_SIZEOF_FIX_BIGNUM], *a = ab, res;

  if (x & C_FIXNUM_BIT) /* Enforce a bignum again (may have been normalized) */
    x = C_a_u_i_fix_to_big(&a, x);

  res = C_u_i_bignum_cmp(x, y);
  if (res == C_fix(0)) /* Use diff to break ties */
    C_kontinue(k, C_mk_bool(diff == comparator));
  else
    C_kontinue(k, C_mk_bool(res == comparator));
}

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 ? C_BIGNUM_HEADER_SIGN_BIT | size : size);

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

/* 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_word *start = C_bignum_digits(big);
  C_word *last_digit = start + C_bignum_size(big) - 1;
  C_word *scan = last_digit, 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));
      /* Set internal header. */
      C_bignum_header(big) = (C_bignum_header(big) & C_BIGNUM_HEADER_SIGN_BIT) | length;
    }
    return big;
  }
}

static C_word
bignum_digits_destructive_scale_up_with_carry(C_word *start, C_word *end, C_word factor, C_word carry)
{
  C_word 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_word
bignum_digits_destructive_scale_down(C_word *start, C_word *end, C_word denominator)
{
  C_word numerator, remainder = 0, digit, quotient_high, *scan = end;

  assert((denominator > 1) && C_fitsinbignumhalfdigitp(denominator));
  while (start <= scan) {
    digit = *scan;
    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));
    (*scan--) = C_BIGNUM_DIGIT_COMBINE(quotient_high, numerator / denominator);
    remainder = numerator % denominator;
  }
  return remainder;
}

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, *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));

  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_FIXNUM_BIT) {
    absy = C_unfix(y);
    absy = absy < 0 ? -absy : absy;
    negp = C_mk_bool((y & C_INT_SIGN_BIT) ?
		     !C_bignum_negativep(x) :
		     C_bignum_negativep(x));
  
    if (C_fitsinbignumhalfdigitp(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),
	 fixy = C_block_item(self, 3),
	 *digits = C_bignum_digits(new_big),
	 *end_digit = digits + C_bignum_size(old_bigx);

  bignum_digits_destructive_copy(new_big, old_bigx);

  /* Scale up, and sanitise the result. */
  *end_digit = bignum_digits_destructive_scale_up_with_carry(digits, end_digit,
                                                             C_unfix(fixy), 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));
}

/* 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 void
bignum_times_bignum_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(x) <= size(y) */
    C_word z = x;
    x = y;
    y = z;
  }

  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);
}

static C_regparm void
bignum_digits_multiply(C_word x, C_word y, C_word result)
{
  C_word 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)),
         *digits = C_bignum_digits(result),
         *last_digit = digits, /* Initially, bignum is all zeroes */
         big_digit = 0, factor = radix,
         next_big_digit, next_factor,
         carry, str_digit;
  char *str_scan = C_c_string(str) + start,
       *str_end = C_c_string(str) + end;

  /* 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')))

  /* This tries 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.
   */
  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_big_digit) &&
	       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;
    }
  }
# undef HEXDIGIT_CHAR_TO_INT

  /* 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 */

  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)
{
  /* This copies the bignum over into a working copy that can be mutated. */
  C_word kab[C_SIZEOF_CLOSURE(4)], *ka = kab, k2, size,
         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);
  }

  k2 = C_closure(&ka, 4, (C_word)bignum_to_digits_2, k, num, radix);

  size = C_fix(C_bignum_size(num));
  C_allocate_bignum(5, (C_word)NULL, k2, size, negp, C_SCHEME_FALSE);
}

static void
bignum_to_digits_2(C_word c, C_word self, C_word working_copy)
{
  C_word k = C_block_item(self, 1),
         old_big = C_block_item(self, 2),
         radix = C_unfix(C_block_item(self, 3)),
         len;

  bignum_digits_destructive_copy(working_copy, old_big);

  /* 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(radix)-1; /* Is this right? */
  len = (C_unfix(C_u_i_bignum_length(old_big)) + len/2) / len
	  + (C_bignum_negativep(old_big) ? 1 : 0);

  /* Nice: We can recycle the current closure */
  C_set_block_item(self, 0, (C_word)bignum_to_digits_3);
  /* item 1 is still the same continuation */
  C_set_block_item(self, 2, working_copy);

  C_allocate_vector(6, (C_word)NULL, self, C_fix(len),
                    /* Byte vec, no initialization, align at 8 bytes */
                    C_SCHEME_TRUE, C_SCHEME_FALSE, C_SCHEME_FALSE);
}

/* XXX TODO: This should be MUCH faster, dammit! */
static void
bignum_to_digits_3(C_word c, C_word self, C_word string)
{
  static char *characters = "0123456789abcdef";
  C_word k = C_block_item(self, 1),
         working_copy = C_block_item(self, 2),
         radix = C_unfix(C_block_item(self, 3)),
         *start = C_bignum_digits(working_copy),
         *scan = start + C_bignum_size(working_copy) - 1,
         len = C_header_size(string)+(C_bignum_negativep(working_copy) ? 1 : 0),
         digit, steps, i, base;
  char *buf = C_c_string(string), *index = buf + C_header_size(string) - 1;

  /* 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 == 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 (C_bignum_negativep(working_copy))
    *--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. */
  }
  C_kontinue(k, string);
}

C_regparm double C_bignum_to_double(C_word bignum)
{
  double accumulator = 0;
  C_word *start = C_bignum_digits(bignum);
  C_word *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);
}

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 digit, k = C_block_item(self, 1),
         exponent = C_unfix(C_block_item(self, 2)),
         odd_bits = exponent % C_BIGNUM_DIGIT_LENGTH,
         *start = C_bignum_digits(result),
         *scan = start + C_bignum_size(result);
  /* It's always true that 0.5 <= s < 1 */
  double significand = C_flonum_magnitude(C_block_item(self, 3));

  if (odd_bits > 0) { /* Handle most significant digit first */
    significand *= (C_word)1 << odd_bits;
    digit = (C_word)significand;
    (*--scan) = digit;
    significand -= (double)digit;
  }

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

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

  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_word 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)),
	 *scanx, *scanr, *end;

  if (shift_left) {
    scanr = C_bignum_digits(result) + digit_offset;
    scanx = C_bignum_digits(x);
    end = scanx + C_bignum_size(x);
    
    while (scanx < end) {
      *scanr = *scanr | (*scanx & C_BIGNUM_DIGIT_MASK) << bit_offset;
      *scanr = *scanr & C_BIGNUM_DIGIT_MASK;
      scanr++;
      *scanr = *scanx++ >> (C_BIGNUM_DIGIT_LENGTH - bit_offset);
      *scanr = *scanr & C_BIGNUM_DIGIT_MASK;
    }
  } else {
    scanr = C_bignum_digits(result);
    scanx = C_bignum_digits(x) + digit_offset;
    end = scanr + C_bignum_size(result) - 1;
    
    while (scanr < end) {
      *scanr =  (*scanx++ & C_BIGNUM_DIGIT_MASK) >> bit_offset;
      *scanr = (*scanr | 
        *scanx << (C_BIGNUM_DIGIT_LENGTH - bit_offset)) & C_BIGNUM_DIGIT_MASK;
      scanr++;
    }
    *scanr =  (*scanx++ & C_BIGNUM_DIGIT_MASK) >> bit_offset;
  }
  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_word 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)),
	 *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),
         *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),
         *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;

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

  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),
         *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;

    if (C_fitsinbignumdigitp(digit1)) {
      carry1 = 0;
    } else {
      digit1 &= C_BIGNUM_DIGIT_MASK;
      carry1 = 1;
    }
    if (C_fitsinbignumdigitp(digit2)) {
      carry2 = 0;
    } else {
      digit2 &= C_BIGNUM_DIGIT_MASK;
      carry2 = 1;
    }
    
    *scanr++ = (op == C_fix(0)) ? digit1 & digit2 :
               (op == C_fix(1)) ? digit1 | digit2 :
                                  digit1 ^ digit2;
  }

  bignum_maybe_negate_magnitude(k, result);
}

static void
bignum_maybe_negate_magnitude(C_word k, C_word result)
{
  if (C_bignum_negativep(result)) {
    C_word *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;

      if (C_fitsinbignumdigitp(digit)) {
        carry = 0;
      } else {
        digit &= C_BIGNUM_DIGIT_MASK;
        carry = 1;
      }
    
      *scan++ = digit;
    }
  }
  C_kontinue(k, C_bignum_simplify(result));
}

/* XXX Figure out if maybe we can get rid of _quotient and _remainder.
 * The divrem operation is more fundamental.
 */
void C_ccall
C_basic_divrem(C_word c, C_word self, C_word k, C_word loc, C_word x, C_word y)
{
  C_word ab[nmax(/* C_SIZEOF_FIX_BIGNUM, */ C_SIZEOF_FLONUM * 3,
                 C_SIZEOF_CLOSURE(5))], *a = ab, k2, q, r;

  /* We could calculate the remainder from the quotient inline to
   * speed things up a tiny bit, but that's less readable.
   */
  if (x & C_FIXNUM_BIT) {
    if (y & C_FIXNUM_BIT) {
      r = C_u_i_fixnum_remainder_checked_loc(loc, x, y);
      q = C_a_u_i_fixnum_quotient_checked_loc(&a, 3, loc, x, y);
      C_values(4, C_SCHEME_UNDEFINED, k, q, r);
    } 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);
      r = C_a_i_flonum_remainder_checked_loc(&a, 3, loc, x, y);
      q = C_a_i_flonum_quotient_checked_loc(&a, 3, loc, x, y);
      C_values(4, C_SCHEME_UNDEFINED, k, q, r);
    } else if (C_IS_BIGNUM_TYPE(y)) {
      C_u_integer_divrem(5, (C_word)NULL, k, loc, x, y);
    } 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);
      r = C_a_i_flonum_remainder_checked_loc(&a, 3, loc, x, y);
      q = C_a_i_flonum_quotient_checked_loc(&a, 3, loc, x, y);
      C_values(4, C_SCHEME_UNDEFINED, k, q, 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) {
      r = C_a_i_flonum_remainder_checked_loc(&a, 3, loc, x, y);
      q = C_a_i_flonum_quotient_checked_loc(&a, 3, loc, x, y);
      C_values(4, C_SCHEME_UNDEFINED, k, q, r);
    } else if (C_IS_BIGNUM_TYPE(y)) {
      k2 = C_closure(&a, 5, (C_word)divrem_intflo,
                     k, loc, C_SCHEME_TRUE, y);
      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) {
      C_u_integer_divrem(5, (C_word)NULL, k, 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) {
      k2 = C_closure(&a, 5, (C_word)divrem_intflo,
                     k, loc, C_SCHEME_FALSE, x);
      C_u_flo_to_int(4, (C_word)NULL, k2, loc, y);
    } else if (C_IS_BIGNUM_TYPE(y)) {
      C_u_bignum_remainder(4, (C_word)NULL, k, x, y);
    } 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),
	 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))
    C_u_integer_divrem(5, (C_word)NULL, k2, loc, intnum, other_arg);
  else
    C_u_integer_divrem(5, (C_word)NULL, k2, loc, other_arg, intnum);
}

static void divrem_intflo_2(C_word c, C_word self, C_word x, C_word y)
{
   C_word k = C_block_item(self, 1),
          ab[C_SIZEOF_FLONUM * 2], *a = ab;
   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);
}

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)
{
  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)) {
        C_values(4, C_SCHEME_UNDEFINED, k, C_fix(-1), C_fix(0));
      } else {
        C_values(4, C_SCHEME_UNDEFINED, k, C_fix(0), x);
      }
    } else {
      C_u_bignum_divrem(4, (C_word)NULL, k, x, y);
    }
  } else if (x & C_FIXNUM_BIT) { /* both x and y are fixnum. */
    C_word ab[C_SIZEOF_FIX_BIGNUM], *a = ab;
    C_values(4, C_SCHEME_UNDEFINED, k,
	     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);

    if (y == C_fix(1)) {
      C_values(4, C_SCHEME_UNDEFINED, k, 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(2)], *ka = kab, k2;
      k2 = C_closure(&ka, 2, (C_word)bignum_divrem_fixnum_2, k);
      C_u_bignum_negate(3, (C_word)NULL, k2, x);
    } else if (C_fitsinbignumhalfdigitp(absy)) { /* Fast: div by halfdigit */
      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_halfdigit,
                     k, x, C_fix(absy), /* Return quotient *and* remainder */
                     C_SCHEME_TRUE, C_SCHEME_TRUE, C_SCHEME_FALSE);
      C_allocate_bignum(5, (C_word)NULL, k2, size, q_negp, C_SCHEME_FALSE);
    } else {			/* Just divide it as two bignums */
      C_word ab[C_SIZEOF_FIX_BIGNUM], *a = ab;
      C_u_bignum_divrem(4, (C_word)NULL, k, x, C_a_u_i_fix_to_big(&a, 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);
   C_values(4, C_SCHEME_UNDEFINED, k, negated_big, C_fix(0));
}

void C_ccall
C_u_bignum_divrem(C_word c, C_word self, C_word k, C_word x, C_word y)
{
  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:
    C_values(4, C_SCHEME_UNDEFINED, k,
             C_truep(q_negp) ? C_fix(-1) : C_fix(1), C_fix(0));
  case -1:
    C_values(4, C_SCHEME_UNDEFINED, k, C_fix(0), x);
  case 1:
  default:
    k2 = C_closure(&ka, 9, (C_word)bignum_divide_2_unsigned, k, x, y,
                   /* Return quotient *and* remainder */
                   C_SCHEME_TRUE, C_SCHEME_TRUE, 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);
  }
}

void C_ccall
C_basic_remainder(C_word c, C_word self, C_word k, C_word loc, C_word x, C_word y)
{
  C_word ab[nmax(C_SIZEOF_FLONUM * 2, C_SIZEOF_CLOSURE(5))], *a = ab, k2;

  if (x & C_FIXNUM_BIT) {
    if (y & C_FIXNUM_BIT) {
      C_kontinue(k, 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);
      x = C_a_i_flonum_remainder_checked_loc(&a, 3, loc, x, y);
      C_kontinue(k, x);
    } else if (C_IS_BIGNUM_TYPE(y)) {
      C_u_integer_remainder(5, (C_word)NULL, k, loc, x, y);
    } else {
      barf(C_BAD_ARGUMENT_TYPE_NO_INTEGER_ERROR, C_strloc(loc), y);
    }
  } else if (C_immediatep(x)) {
    barf(C_BAD_ARGUMENT_TYPE_NO_INTEGER_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);
      x = C_a_i_flonum_remainder_checked_loc(&a, 3, loc, x, y);
      C_kontinue(k, x);
    } 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_flonum_remainder_checked_loc(&a, 3, loc, x, y);
      C_kontinue(k, x);
    } else if (C_IS_BIGNUM_TYPE(y)) {
      k2 = C_closure(&a, 5, (C_word)remainder_intflo,
                     k, loc, C_SCHEME_TRUE, y);
      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) {
      C_u_integer_remainder(5, (C_word)NULL, k, 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) {
      k2 = C_closure(&a, 5, (C_word)remainder_intflo,
                     k, loc, C_SCHEME_FALSE, x);
      C_u_flo_to_int(4, (C_word)NULL, k2, loc, y);
    } else if (C_IS_BIGNUM_TYPE(y)) {
      C_u_bignum_remainder(4, (C_word)NULL, k, x, y);
    } else {
      barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, C_strloc(loc), y);
    }
  } else {
    barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, C_strloc(loc), x);
  }
}

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)
{
  if (!(y & C_FIXNUM_BIT)) { /* y is bignum. */
    if (x & C_FIXNUM_BIT) {
      /* abs(x) < abs(y), so it will always be x except for this case: */
      if (x == C_fix(C_MOST_NEGATIVE_FIXNUM) &&
          C_bignum_negated_fitsinfixnump(y)) {
        C_kontinue(k, C_fix(0));
      } else {
	C_kontinue(k, x);
      }
    } else {
      C_u_bignum_remainder(4, (C_word)NULL, k, x, y);
    }
  } else if (x & C_FIXNUM_BIT) { /* both x and y are fixnum. */
    C_kontinue(k, 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);

    if (absy == 1) {
      C_kontinue(k, C_fix(0));
    } else if (absy == 0) {
      C_div_by_zero_error(C_strloc(loc));
    } else if (C_fitsinbignumhalfdigitp(absy)) { /* Fast: div by halfdigit */
      C_word 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;
      C_u_bignum_remainder(4, (C_word)NULL, k, x, C_a_u_i_fix_to_big(&a, y));
    }
  }
}

static void remainder_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),
	 kab[C_SIZEOF_CLOSURE(2)], *ka = kab, k2;
  
  k2 = C_closure(&ka, 2, (C_word)remainder_intflo_2, k);
  if (C_truep(intnum_is_x))
    C_u_integer_remainder(5, (C_word)NULL, k2, loc, intnum, other_arg);
  else
    C_u_integer_remainder(5, (C_word)NULL, k2, loc, other_arg, intnum);
}

static void remainder_intflo_2(C_word c, C_word self, C_word x)
{
   C_word k = C_block_item(self, 1),
          ab[C_SIZEOF_FLONUM], *a = ab;
   if (x & C_FIXNUM_BIT) C_kontinue(k, C_a_i_fix_to_flo(&a, 1, x));
   else C_kontinue(k, C_a_u_i_big_to_flo(&a, 1, x));
}

void C_ccall
C_u_bignum_remainder(C_word c, C_word self, C_word k, C_word x, C_word y)
{
  C_word ab[C_SIZEOF_FIX_BIGNUM+C_SIZEOF_CLOSURE(9)], *a = ab, k2, size, negp;

  switch(bignum_cmp_unsigned(x, y)) {
  case 0:
    C_kontinue(k, C_fix(0));
  case -1:
    C_kontinue(k, x);
  case 1:
  default:
    negp = C_mk_bool(C_bignum_negativep(x));

    /* We can skip bignum_divide_2_unsigned because we need no quotient */
    k2 = C_closure(&a, 9, (C_word)bignum_divide_2_unsigned_2, k, x, y,
                   /* Do not return quotient, do return remainder */
                   C_SCHEME_FALSE, C_SCHEME_TRUE, negp,
                   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, negp, C_SCHEME_FALSE);
  }
}

static C_word
bignum_remainder_unsigned_halfdigit(C_word num, C_word den)
{
  C_word *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;
}

void C_ccall
C_basic_quotient(C_word c, C_word self, C_word k, C_word loc, C_word x, C_word y)
{
  C_word ab[nmax(/* C_SIZEOF_FIX_BIGNUM, */ C_SIZEOF_FLONUM * 2,
                 C_SIZEOF_CLOSURE(5))], *a = ab, k2;

  if (x & C_FIXNUM_BIT) {
    if (y & C_FIXNUM_BIT) {
      C_kontinue(k, C_a_u_i_fixnum_quotient_checked_loc(&a, 3, 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);
      x = C_a_i_flonum_quotient_checked_loc(&a, 3, loc, x, y);
      C_kontinue(k, x);
    } else if (C_IS_BIGNUM_TYPE(y)) {
      C_u_integer_quotient(5, (C_word)NULL, k, loc, x, y);
    } else {
      barf(C_BAD_ARGUMENT_TYPE_NO_INTEGER_ERROR, C_strloc(loc), y);
    }
  } else if (C_immediatep(x)) {
    barf(C_BAD_ARGUMENT_TYPE_NO_INTEGER_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);
      x = C_a_i_flonum_quotient_checked_loc(&a, 3, loc, x, y);
      C_kontinue(k, x);
    } 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_flonum_quotient_checked_loc(&a, 3, loc, x, y);
      C_kontinue(k, x);
    } else if (C_IS_BIGNUM_TYPE(y)) {
      k2 = C_closure(&a, 5, (C_word)quotient_intflo,
                     k, loc, C_SCHEME_TRUE, y);
      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) {
      C_u_integer_quotient(5, (C_word)NULL, k, 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) {
      k2 = C_closure(&a, 5, (C_word)quotient_intflo,
                     k, loc, C_SCHEME_FALSE, x);
      C_u_flo_to_int(4, (C_word)NULL, k2, loc, y);
    } else if (C_IS_BIGNUM_TYPE(y)) {
      C_u_bignum_quotient(4, (C_word)NULL, k, x, y);
    } 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);
  }
}

static void quotient_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),
	 kab[C_SIZEOF_CLOSURE(2)], *ka = kab, k2;
  
  k2 = C_closure(&ka, 2, (C_word)quotient_intflo_2, k);
  if (C_truep(intnum_is_x))
    C_u_integer_quotient(5, (C_word)NULL, k2, loc, intnum, other_arg);
  else
    C_u_integer_quotient(5, (C_word)NULL, k2, loc, other_arg, intnum);
}

static void quotient_intflo_2(C_word c, C_word self, C_word x)
{
   C_word k = C_block_item(self, 1),
          ab[C_SIZEOF_FLONUM], *a = ab;
   if (x & C_FIXNUM_BIT) C_kontinue(k, C_a_i_fix_to_flo(&a, 1, x));
   else C_kontinue(k, C_a_u_i_big_to_flo(&a, 1, x));
}

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)
{
  if (!(y & C_FIXNUM_BIT)) { /* y is bignum. */
    if (x & C_FIXNUM_BIT) {
      /* abs(x) < abs(y), so it will always be zero except for this case: */
      if (x == C_fix(C_MOST_NEGATIVE_FIXNUM) &&
          C_bignum_negated_fitsinfixnump(y)) {
        C_kontinue(k, C_fix(-1));
      } else {
	C_kontinue(k, C_fix(0));
      }
    } else {
      C_u_bignum_quotient(4, (C_word)NULL, k, x, y);
    }
  } else if (x & C_FIXNUM_BIT) { /* both x and y are fixnum. */
    C_word ab[C_SIZEOF_FIX_BIGNUM], *a = ab;
    C_kontinue(k, C_a_u_i_fixnum_quotient_checked_loc(&a, 3, loc, x, y));
  } else { /* x is bignum, y is fixnum. */
    C_word absy = (y < 0) ? -C_unfix(y) : C_unfix(y);
    
    if (y == C_fix(1)) {
      C_kontinue(k, x);
    } else if (y == C_fix(0)) {
      C_div_by_zero_error(C_strloc(loc));
    } else if (y == C_fix(-1)) {
      C_u_bignum_negate(3, (C_word)NULL, k, x);
    } else if (C_fitsinbignumhalfdigitp(absy)) {
      C_word negp = C_mk_bool((y < 0) ? !C_bignum_negativep(x) :
                                        C_bignum_negativep(x)),
             kab[C_SIZEOF_CLOSURE(7)], *ka = kab, k2,
             size, func;

      size = C_fix(C_bignum_size(x));
      k2 = C_closure(&ka, 7,
                     (C_word)bignum_destructive_divide_unsigned_halfdigit,
		     k, x, C_fix(absy), /* Return quotient, not remainder */
                     C_SCHEME_TRUE, C_SCHEME_FALSE, C_SCHEME_FALSE);
      C_allocate_bignum(5, (C_word)NULL, k2, size, negp, C_SCHEME_FALSE);
    } else {			/* Just divide it as two bignums */
      C_word ab[C_SIZEOF_FIX_BIGNUM], *a = ab;
      C_u_bignum_quotient(4, (C_word)NULL, k, x, C_a_u_i_fix_to_big(&a, y));
    }
  }
}

void C_ccall
C_u_bignum_quotient(C_word c, C_word self, C_word k, C_word x, C_word y)
{
  C_word ab[C_SIZEOF_CLOSURE(9)], *a = ab, k2, size,
         negp = C_mk_bool(C_bignum_negativep(x) ?
                         !C_bignum_negativep(y) :
                         C_bignum_negativep(y));

  switch(bignum_cmp_unsigned(x, y)) {
  case 0:
    C_kontinue(k, C_truep(negp) ? C_fix(-1) : C_fix(1));
  case -1:
    C_kontinue(k, C_fix(0));
  case 1:
  default:
    k2 = C_closure(&a, 9, (C_word)bignum_divide_2_unsigned, k, x, y,
                   /* Return quotient, not remainder */
                   C_SCHEME_TRUE, C_SCHEME_FALSE, C_SCHEME_FALSE,
		   /* 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, negp, C_SCHEME_FALSE);
  }
}

static void
bignum_destructive_divide_unsigned_halfdigit(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),
         *start = C_bignum_digits(quotient),
         *end = start + C_bignum_size(quotient) - 1,
         remainder;

  bignum_digits_destructive_copy(quotient, numerator);

  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);
  }
}


static void
bignum_destructive_normalize(C_word target, C_word source, C_word shift_left)
{
  C_word 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),
         shift_right = C_BIGNUM_DIGIT_LENGTH - shift_left,
         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);
}

/* TODO: This pointer stuff here is suspicious: it's probably slow */
static C_word
bignum_divide_and_subtract_digit(C_word v1, C_word v2, C_word guess, C_word *u)
{
  C_word product, diff, sum, carry;

  product = v2 * guess;
  diff = u[2] - C_BIGNUM_DIGIT_LO_HALF(product);
  if (diff < 0) {
    u[2] = diff + ((C_word)1 << C_BIGNUM_HALF_DIGIT_LENGTH);
    carry = C_BIGNUM_DIGIT_HI_HALF(product) + 1;
  } else {
    u[2] = diff;
    carry = C_BIGNUM_DIGIT_HI_HALF(product);
  }
  
  product = v1 * guess + carry;
  diff = u[1] - C_BIGNUM_DIGIT_LO_HALF(product);
  if (diff < 0) {
    u[1] = diff + ((C_word)1 << C_BIGNUM_HALF_DIGIT_LENGTH);
    carry = C_BIGNUM_DIGIT_HI_HALF(product) + 1;
  } else {
    u[1] = diff;
    carry = C_BIGNUM_DIGIT_HI_HALF(product);
    if (carry == 0) return guess; /* DONE */
  }

  diff = u[0] - carry;
  if (diff < 0) {
    u[0] = diff + ((C_word)1 << C_BIGNUM_HALF_DIGIT_LENGTH);
  } else {
    u[0] = diff;
    return guess; /* DONE */
  }

  sum = v2 + u[2];
  u[2] = sum & C_BIGNUM_HALF_DIGIT_MASK;
  carry = C_fitsinbignumhalfdigitp(sum);

  sum = v1 + u[1] + carry;
  u[1] = sum & C_BIGNUM_HALF_DIGIT_MASK;
  carry = C_fitsinbignumhalfdigitp(sum);

  u[0] += carry;

  return guess - 1;
}

/* This is a reduced version of the division algorithm, applied to the
   case of dividing two bignum digits by one bignum digit.  It is
   assumed that the numerator, denominator are normalized. */

#define BDD_STEP(qn, j)                                                 \
{                                                                       \
  uj = u[j];                                                            \
  if (uj != v1) {							\
    uj_uj1 = C_BIGNUM_DIGIT_COMBINE(uj, u[j + 1]);                      \
    guess = uj_uj1 / v1;                                                \
    comparand = C_BIGNUM_DIGIT_COMBINE(uj_uj1 % v1, u[j + 2]);          \
  } else {								\
    guess = C_BIGNUM_HALF_DIGIT_MASK;                                   \
    comparand = C_BIGNUM_DIGIT_COMBINE(u[j + 1] + v1, u[j + 2]);        \
  }                                                                     \
  while ((guess * v2) > comparand) {					\
    guess -= 1;                                                         \
    comparand += v1 << C_BIGNUM_HALF_DIGIT_LENGTH;                      \
    if (!C_fitsinbignumdigitp(comparand))                               \
      break;                                                            \
  }                                                                     \
  qn = bignum_divide_and_subtract_digit(v1, v2, guess, &u[j]);          \
}

/* Because the algorithm from Knuth requires combining the two highest
 * digits of u (which we can't fit in a C_word), we instead do two
 * such steps, a halfdigit at a time.
 */
static C_word
bignum_divide_digit(C_word uh, C_word ul, C_word v, C_word *q)
{
  C_word guess, comparand, v1, v2, uj, uj_uj1, q1, q2, u[4];

  if (uh == 0) {
    if (ul < v) {
      *q = 0;
      return ul;
    } else if (ul == v) {
      *q = 1;
      return 0;
    }
  }
  u[0] = C_BIGNUM_DIGIT_HI_HALF(uh);
  u[1] = C_BIGNUM_DIGIT_LO_HALF(uh);
  u[2] = C_BIGNUM_DIGIT_HI_HALF(ul);
  u[3] = C_BIGNUM_DIGIT_LO_HALF(ul);
  v1 = C_BIGNUM_DIGIT_HI_HALF(v);
  v2 = C_BIGNUM_DIGIT_LO_HALF(v);
  BDD_STEP(q1, 0);
  BDD_STEP(q2, 1);
  *q = C_BIGNUM_DIGIT_COMBINE(q1, q2);
  return C_BIGNUM_DIGIT_COMBINE(u[2], u[3]);
}

#undef BDD_STEP

/* 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". */

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_d = C_bignum_size(denominator),
	 d1 = *(C_bignum_digits(denominator) + length_d - 1),
         shift = 0;

  while (d1 < ((C_word)1 << (C_BIGNUM_DIGIT_LENGTH-1))) {
    d1 <<= 1;
    shift++;
  }

  if (shift == 0) { /* Already normalized */
    bignum_digits_destructive_copy(remainder, numerator);
    /* Set most significant digit */
    *(C_bignum_digits(remainder) + C_bignum_size(numerator)) = 0;

    bignum_destructive_divide_normalized(remainder, denominator, quotient);

    if (C_truep(C_and(return_quotient, return_remainder))) {
      C_values(4, C_SCHEME_UNDEFINED, k,
               C_bignum_simplify(quotient), C_bignum_simplify(remainder));
    } else if (C_truep(return_remainder)) {
      C_kontinue(k, C_bignum_simplify(remainder));
    } else {
      assert(C_truep(return_quotient));
      C_kontinue(k, C_bignum_simplify(quotient));
    }
  } else {
    /* Requires normalisation of denominator;  Allocate temp bignum for it. */
    C_set_block_item(self, 0, (C_word)bignum_divide_2_unsigned_3);
    C_set_block_item(self, 6, remainder);
    C_set_block_item(self, 8, C_fix(shift));
    C_allocate_bignum(5, (C_word)NULL, self, C_fix(length_d),
                      C_SCHEME_FALSE, C_SCHEME_FALSE);
  }
}

static void
bignum_divide_2_unsigned_3(C_word c, C_word self, C_word tmp_big)
{
  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),
         remainder = C_block_item(self, 6),
         quotient = C_block_item(self, 7),
         shift = C_unfix(C_block_item(self, 8));

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

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

static void
bignum_destructive_divide_normalized(C_word u, C_word v, C_word q)
{
  C_word u_length = C_bignum_size(u),
         v_length = C_bignum_size(v),
         *u_start = C_bignum_digits(u),
         *u_scan = u_start + u_length,
         *u_scan_limit = u_start + v_length,
         *u_scan_start = u_scan - v_length,
         *v_start = C_bignum_digits(v),
         *v_end = v_start + v_length,
         *q_scan = (q == C_SCHEME_UNDEFINED) ? NULL :
                   (C_bignum_digits(q) + C_bignum_size(q)),
         v1 = v_end[-1],
         v2 = v_length == 1 ? 0 : v_end[-2],
         ph, /* high half of double-digit product */
         pl, /* low half of double-digit product */
         guess, uj, qj,
         gh, /* high half-digit of guess */
         ch, /* high half of double-digit comparand */
         v2l = C_BIGNUM_DIGIT_LO_HALF(v2),
         v2h = C_BIGNUM_DIGIT_HI_HALF(v2),
         cl, /* low half of double-digit comparand */
         gl, /* low half-digit of guess */
         gm; /* memory loc for reference parameter */

  while (u_scan_limit < u_scan) {
    uj = (*--u_scan);
    if (uj != v1) {
      /* comparand = (((((uj * B) + uj1) % v1) * b) + uj2);
         guess = (((uj * B) + uj1) / v1); */
      cl = u_scan[-2];
      ch = bignum_divide_digit(uj, (u_scan[-1]), v1, (&gm));
      guess = gm;
    } else {
      cl = u_scan[-2];
      ch = u_scan[-1] + v1;
      guess = C_BIGNUM_DIGIT_MASK;
    }
    while (1) {
      /* product = (guess * v2); */
      gl = C_BIGNUM_DIGIT_LO_HALF(guess);
      gh = C_BIGNUM_DIGIT_HI_HALF(guess);
      pl = v2l * gl;
      ph = v2l * gh + v2h * gl + C_BIGNUM_DIGIT_HI_HALF(pl);
      pl = C_BIGNUM_DIGIT_COMBINE(C_BIGNUM_DIGIT_LO_HALF(ph),
                                  C_BIGNUM_DIGIT_LO_HALF(pl));
      ph = v2h * gh + C_BIGNUM_DIGIT_HI_HALF(ph);
      /* if (comparand >= product) */
      if ((ch > ph) || ((ch == ph) && (cl >= pl)))
        break;
      guess--;
      /* comparand += (v1 << C_BIGNUM_DIGIT_LENGTH) */
      ch += v1;
      /* if (comparand >= (B^2)) */
      if (!C_fitsinbignumdigitp(ch))
        break;
    }
    qj = bignum_divide_and_subtract(v_start, v_end, guess, (--u_scan_start));
    if (q_scan != NULL)
      (*--q_scan) = qj;
  }
}

static C_word
bignum_divide_and_subtract(C_word *v_start, C_word *v_end, C_word guess, C_word *u_start)
{
  if (guess == 0) {
    return 0;
  } else {
    C_word *v_scan = v_start,
           *u_scan = u_start,
           carry = 0,
           gl, gh, v, pl, vl, vh, ph, diff, sum;

    gl = C_BIGNUM_DIGIT_LO_HALF(guess);
    gh = C_BIGNUM_DIGIT_HI_HALF(guess);
    while (v_scan < v_end) {
      v = (*v_scan++);
      vl = C_BIGNUM_DIGIT_LO_HALF(v);
      vh = C_BIGNUM_DIGIT_HI_HALF(v);
      pl = vl * gl + C_BIGNUM_DIGIT_LO_HALF(carry);
      ph = vl * gh + vh * gl + C_BIGNUM_DIGIT_HI_HALF(pl) +
                               C_BIGNUM_DIGIT_HI_HALF(carry);
      diff = (*u_scan) - C_BIGNUM_DIGIT_COMBINE(C_BIGNUM_DIGIT_LO_HALF(ph),
                                                C_BIGNUM_DIGIT_LO_HALF(pl));
      if (diff < 0) {
        (*u_scan++) = diff + ((C_word)1 << C_BIGNUM_DIGIT_LENGTH);
        carry = vh * gh + C_BIGNUM_DIGIT_HI_HALF(ph) + 1;
      } else {
        (*u_scan++) = diff;
        carry = vh * gh + C_BIGNUM_DIGIT_HI_HALF(ph);
      }
    }
    if (carry == 0)
      return guess;

    diff = ((*u_scan) - carry);
    if (diff < 0) {
      (*u_scan) = diff + ((C_word)1 << C_BIGNUM_DIGIT_LENGTH);
    } else {
      (*u_scan) = diff;
      return guess;
    }
  
    /* Subtraction generated carry, implying guess is one too large.
       Add v back in to bring it back down. */
    v_scan = v_start;
    u_scan = u_start;
    carry = 0;
    while (v_scan < v_end) {
      sum = ((*v_scan++) + (*u_scan) + carry);
      if (C_fitsinbignumdigitp(sum)) {
        (*u_scan++) = sum;
        carry = 0;
      } else {
        (*u_scan++) = sum & C_BIGNUM_DIGIT_MASK;
        carry = 1;
      }
    }
    if (carry) {
      sum = (*u_scan) + carry;
      (*u_scan) = C_fitsinbignumdigitp(sum) ? sum : (sum  & C_BIGNUM_DIGIT_MASK);
    }
    return guess - 1;
  }
}

/* Like bignum_simplify, but this also shifts division-normalized
 * numbers, to denormalize them to regular bignum representation.
 */
static C_word
bignum_simplify_shifted(C_word big, C_word shift_right)
{
  C_word length = C_bignum_size(big),
        *start = C_bignum_digits(big),
        *scan = start + length,
        digit, carry = 0,
        shift_left = C_BIGNUM_DIGIT_LENGTH - shift_right,
        mask = (1L << shift_right) - 1;
  
  while (!(*--scan)) {
    if (start == scan) { /* Don't bother with anything else */
      return C_fix(0);
    }
    --length;
  }

  digit = (*scan);
  (*scan) = (digit >> shift_right);
  length -= (*scan == 0); /* Add 1 or 0 */
  carry = ((digit & mask) << shift_left);
  
  while (start < scan) {
    digit = (*--scan);
    (*scan) = ((digit >> shift_right) | carry);
    carry = ((digit & mask) << shift_left);
  }
  assert(carry == 0);
  /* This is only correct for remainder, not when normalizing tmp_y in gcd */
  /* assert(C_bignum_size(big) != length); */
  assert(length != 1 || *C_bignum_digits(big) != 0);

  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:
    /* Mutate vector size of internal bignum vector. */
    C_block_header(C_internal_bignum(big)) = (C_STRING_TYPE | C_wordstobytes(length+1));
    /* Set internal header. */
    C_bignum_header(big) = (C_bignum_header(big) & C_BIGNUM_HEADER_SIGN_BIT) | length;
    return big;
  }
}