Back to index

plt-scheme  4.2.1
Defines | Functions | Variables
number.c File Reference
#include "schpriv.h"
#include "nummacs.h"
#include <math.h>
#include <string.h>
#include <ctype.h>
#include <signal.h>

Go to the source code of this file.

Defines

#define MAX_SHIFT_TRY   29
#define MAX_SHIFT_EVER   32
#define zeroi   scheme_exact_zero
#define TO_DOUBLE_VAL   scheme_get_val_as_double
#define TO_DOUBLE   scheme_TO_DOUBLE
#define GEN_ZERO_IS_ZERO()   if (o == zeroi) return zeroi;
#define GEN_ZERO_IS_ONE()   if (o == zeroi) return scheme_make_integer(1);
#define GEN_ONE_IS_ZERO()   if (o == scheme_exact_one) return zeroi;
#define GEN_ONE_IS_ZERO_AND_ZERO_IS_ERR()   if (o == scheme_exact_one) return zeroi; else if (o == zeroi) scheme_raise_exn(MZEXN_FAIL_CONTRACT_DIVIDE_BY_ZERO, "log: undefined for 0");
#define GEN_ZERO_IS_HALF_PI()   if (o == zeroi) return scheme_half_pi;
#define NEVER_RESORT_TO_COMPLEX(d)   0
#define NEGATIVE_USES_COMPLEX(d)   d < 0.0
#define OVER_ONE_MAG_USES_COMPLEX(d)   (d > 1.0) || (d < -1.0)
#define SCH_SIN   sin
#define SCH_COS   cos
#define SCH_TAN   tan
#define SCH_ASIN   asin
#define SCH_LOG   log
#define BIGNUM_LOG(o)   return bignum_log(o);
#define F_EXPT(x, y)
#define FS_EXPT(x, y)
#define MZ_PUBLIC

Functions

static Scheme_Objectnumber_p (int argc, Scheme_Object *argv[])
static Scheme_Objectcomplex_p (int argc, Scheme_Object *argv[])
static Scheme_Objectreal_p (int argc, Scheme_Object *argv[])
static Scheme_Objectrational_p (int argc, Scheme_Object *argv[])
static Scheme_Objectinteger_p (int argc, Scheme_Object *argv[])
static Scheme_Objectexact_integer_p (int argc, Scheme_Object *argv[])
static Scheme_Objectexact_nonnegative_integer_p (int argc, Scheme_Object *argv[])
static Scheme_Objectexact_positive_integer_p (int argc, Scheme_Object *argv[])
static Scheme_Objectfixnum_p (int argc, Scheme_Object *argv[])
static Scheme_Objectinexact_real_p (int argc, Scheme_Object *argv[])
static Scheme_Objectexact_p (int argc, Scheme_Object *argv[])
static Scheme_Objecteven_p (int argc, Scheme_Object *argv[])
static Scheme_Objectbitwise_or (int argc, Scheme_Object *argv[])
static Scheme_Objectbitwise_xor (int argc, Scheme_Object *argv[])
static Scheme_Objectbitwise_not (int argc, Scheme_Object *argv[])
static Scheme_Objectbitwise_bit_set_p (int argc, Scheme_Object *argv[])
static Scheme_Objectbitwise_bit_field (int argc, Scheme_Object *argv[])
static Scheme_Objectinteger_length (int argc, Scheme_Object *argv[])
static Scheme_Objectgcd (int argc, Scheme_Object *argv[])
static Scheme_Objectlcm (int argc, Scheme_Object *argv[])
static Scheme_Objectfloor_prim (int argc, Scheme_Object *argv[])
static Scheme_Objectceiling (int argc, Scheme_Object *argv[])
static Scheme_Objectsch_truncate (int argc, Scheme_Object *argv[])
static Scheme_Objectsch_round (int argc, Scheme_Object *argv[])
static Scheme_Objectnumerator (int argc, Scheme_Object *argv[])
static Scheme_Objectdenominator (int argc, Scheme_Object *argv[])
static Scheme_Objectexp_prim (int argc, Scheme_Object *argv[])
static Scheme_Objectlog_prim (int argc, Scheme_Object *argv[])
static Scheme_Objectsin_prim (int argc, Scheme_Object *argv[])
static Scheme_Objectcos_prim (int argc, Scheme_Object *argv[])
static Scheme_Objecttan_prim (int argc, Scheme_Object *argv[])
static Scheme_Objectasin_prim (int argc, Scheme_Object *argv[])
static Scheme_Objectacos_prim (int argc, Scheme_Object *argv[])
static Scheme_Objectatan_prim (int argc, Scheme_Object *argv[])
static Scheme_Objectmake_rectangular (int argc, Scheme_Object *argv[])
static Scheme_Objectreal_part (int argc, Scheme_Object *argv[])
static Scheme_Objectimag_part (int argc, Scheme_Object *argv[])
static Scheme_Objectmagnitude (int argc, Scheme_Object *argv[])
static Scheme_Objectangle (int argc, Scheme_Object *argv[])
static Scheme_Objectint_sqrt (int argc, Scheme_Object *argv[])
static Scheme_Objectint_sqrt_rem (int argc, Scheme_Object *argv[])
void scheme_init_number (Scheme_Env *env)
Scheme_Objectscheme_make_integer_value (long i)
Scheme_Objectscheme_make_integer_value_from_unsigned (unsigned long i)
Scheme_Objectscheme_make_integer_value_from_long_long (mzlonglong i)
Scheme_Objectscheme_make_integer_value_from_unsigned_long_long (umzlonglong i)
static Scheme_Objectfixnum_expt (long x, long y)
Scheme_Objectscheme_make_integer_value_from_unsigned_long_halves (unsigned long lowhalf, unsigned long hihalf)
Scheme_Objectscheme_make_integer_value_from_long_halves (unsigned long lowhalf, unsigned long hihalf)
int scheme_get_int_val (Scheme_Object *o, long *v)
int scheme_get_unsigned_int_val (Scheme_Object *o, unsigned long *v)
int scheme_get_long_long_val (Scheme_Object *o, mzlonglong *v)
int scheme_get_unsigned_long_long_val (Scheme_Object *o, umzlonglong *v)
int scheme_nonneg_exact_p (Scheme_Object *n)
double scheme_real_to_double (Scheme_Object *r)
static XFORM_NONGCING MZ_INLINE int minus_zero_p (double d)
int scheme_minus_zero_p (double d)
static int rational_dbl_p (double f)
Scheme_Objectscheme_make_double (double d)
int scheme_is_integer (const Scheme_Object *o)
int scheme_is_exact (const Scheme_Object *n)
int scheme_is_inexact (const Scheme_Object *n)
Scheme_Objectscheme_inexact_p (int argc, Scheme_Object *argv[])
Scheme_Objectscheme_odd_p (int argc, Scheme_Object *argv[])
static Scheme_Objectbin_lcm (Scheme_Object *n1, Scheme_Object *n2)
static Scheme_Objectint_abs (Scheme_Object *v)
Scheme_Objectscheme_bin_gcd (const Scheme_Object *n1, const Scheme_Object *n2)
Scheme_Objectscheme_TO_DOUBLE (const Scheme_Object *n)
double TO_DOUBLE_VAL (const Scheme_Object *n)
Scheme_Objectscheme_to_bignum (const Scheme_Object *o)
static Scheme_Objectget_frac (char *name, int low_p, int argc, Scheme_Object *argv[])
static Scheme_Objectun_exp (Scheme_Object *o)
static Scheme_Objectun_log (Scheme_Object *o)
static Scheme_Objectcomplex_exp (Scheme_Object *c)
static Scheme_Objectcomplex_log (Scheme_Object *c)
static Scheme_Objectbignum_log (Scheme_Object *b)
static Scheme_Objectcomplex_sin (Scheme_Object *c)
static Scheme_Objectcomplex_cos (Scheme_Object *c)
static Scheme_Objectcomplex_tan (Scheme_Object *c)
static Scheme_Objectcomplex_asin (Scheme_Object *c)
static Scheme_Objectcomplex_atan (Scheme_Object *c)
static Scheme_Objectcomplex_acos (Scheme_Object *c)
static Scheme_Objectscheme_inf_plus_pi ()
 GEN_UNARY_OP (log_prim, log, SCH_LOG, scheme_inf_object, scheme_single_inf_object, scheme_inf_plus_pi(), scheme_single_inf_plus_pi(), scheme_nan_object, scheme_single_nan_object, complex_log, GEN_ONE_IS_ZERO_AND_ZERO_IS_ERR, NEGATIVE_USES_COMPLEX, BIGNUM_LOG)
Scheme_Objectscheme_sqrt (int argc, Scheme_Object *argv[])
Scheme_Objectdo_int_sqrt (const char *name, int argc, Scheme_Object *argv[], int w_rem)
static double sch_pow (double x, double y)
 GEN_BIN_PROT (bin_expt)
static GEN_BIN_OP (bin_expt,"expt", fixnum_expt, F_EXPT, FS_EXPT, scheme_generic_integer_power, scheme_rational_power, scheme_complex_power, GEN_RETURN_0_USUALLY, GEN_RETURN_1, NAN_RETURNS_NAN, NAN_RETURNS_SNAN, cx_NO_CHECK, cx_NO_CHECK, cx_NO_CHECK, cx_NO_CHECK)
Scheme_Objectscheme_make_polar (int argc, Scheme_Object *argv[])
Scheme_Objectscheme_exact_to_inexact (int argc, Scheme_Object *argv[])
Scheme_Objectscheme_inexact_to_exact (int argc, Scheme_Object *argv[])
 GEN_BIN_PROT (bin_bitwise_and)
 GEN_BIN_PROT (bin_bitwise_or)
 GEN_BIN_PROT (bin_bitwise_xor)
Scheme_Objectscheme_bitwise_shift (int argc, Scheme_Object *argv[])
static Scheme_Objectslow_bitwise_bit_field (int argc, Scheme_Object *argv[], Scheme_Object *so, Scheme_Object *sb1, Scheme_Object *sb2)
long scheme_integer_length (Scheme_Object *n)

Variables

double scheme_infinity_val
double scheme_minus_infinity_val
static double not_a_number_val
Scheme_Objectscheme_inf_object
Scheme_Objectscheme_minus_inf_object
Scheme_Objectscheme_nan_object
Scheme_Objectscheme_zerod
Scheme_Objectscheme_nzerod
Scheme_Objectscheme_pi
Scheme_Objectscheme_half_pi
Scheme_Objectscheme_plus_i
Scheme_Objectscheme_minus_i
double scheme_floating_point_zero = 0.0
double scheme_floating_point_nzero = 0.0

Define Documentation

#define BIGNUM_LOG (   o)    return bignum_log(o);

Definition at line 1621 of file number.c.

#define F_EXPT (   x,
  y 
)
Value:

Definition at line 1970 of file number.c.

#define FS_EXPT (   x,
  y 
)
Value:

Definition at line 1974 of file number.c.

#define GEN_ONE_IS_ZERO ( )    if (o == scheme_exact_one) return zeroi;

Definition at line 1586 of file number.c.

Definition at line 1587 of file number.c.

#define GEN_ZERO_IS_HALF_PI ( )    if (o == zeroi) return scheme_half_pi;

Definition at line 1588 of file number.c.

#define GEN_ZERO_IS_ONE ( )    if (o == zeroi) return scheme_make_integer(1);

Definition at line 1585 of file number.c.

#define GEN_ZERO_IS_ZERO ( )    if (o == zeroi) return zeroi;

Definition at line 1584 of file number.c.

#define MAX_SHIFT_EVER   32

Definition at line 52 of file number.c.

#define MAX_SHIFT_TRY   29

Definition at line 51 of file number.c.

#define MZ_PUBLIC

Definition at line 2438 of file number.c.

#define NEGATIVE_USES_COMPLEX (   d)    d < 0.0

Definition at line 1591 of file number.c.

#define NEVER_RESORT_TO_COMPLEX (   d)    0

Definition at line 1590 of file number.c.

#define OVER_ONE_MAG_USES_COMPLEX (   d)    (d > 1.0) || (d < -1.0)

Definition at line 1592 of file number.c.

#define SCH_ASIN   asin

Definition at line 1613 of file number.c.

#define SCH_COS   cos

Definition at line 1610 of file number.c.

#define SCH_LOG   log

Definition at line 1619 of file number.c.

#define SCH_SIN   sin

Definition at line 1609 of file number.c.

#define SCH_TAN   tan

Definition at line 1611 of file number.c.

Definition at line 1362 of file number.c.

Definition at line 1318 of file number.c.

#define zeroi   scheme_exact_zero

Definition at line 105 of file number.c.


Function Documentation

static Scheme_Object* acos_prim ( int  argc,
Scheme_Object argv[] 
) [static]

Here is the caller graph for this function:

static Scheme_Object * angle ( int  argc,
Scheme_Object argv[] 
) [static]

Definition at line 2249 of file number.c.

{
  Scheme_Object *o = argv[0];

  if (!SCHEME_NUMBERP(o))
    scheme_wrong_type("angle", "number", 0, argc, argv);

  if (SCHEME_COMPLEXP(o)) {
    Scheme_Object *r = (Scheme_Object *)_scheme_complex_real_part(o);
    Scheme_Object *i = (Scheme_Object *)_scheme_complex_imaginary_part(o);
    double rd, id, v;
#ifdef MZ_USE_SINGLE_FLOATS
# ifdef USE_SINGLE_FLOATS_AS_DEFAULT
    int was_single = !(SCHEME_DBLP(r) || SCHEME_DBLP(i));
# else
    int was_single = (SCHEME_FLTP(r) || SCHEME_FLTP(i));
# endif
#endif

    id = TO_DOUBLE_VAL(i);
    rd = TO_DOUBLE_VAL(r);

    v = atan2(id, rd);

#ifdef MZ_USE_SINGLE_FLOATS
    if (was_single)
      return scheme_make_float((float)v);
#endif

    return scheme_make_double(v);
  } else {
#ifdef MZ_USE_SINGLE_FLOATS
    if (SCHEME_FLTP(o)) {
      float v = SCHEME_FLT_VAL(o);
      if (MZ_IS_NAN(v))
       return scheme_single_nan_object;
      else if (v == 0.0f) {
       int neg;
       neg = minus_zero_p(v);
       v = (neg ? -1.0f : 1.0f);
      }
      if (v > 0)
       return zeroi;
      else
       return scheme_single_pi;
    }
#endif
    if (SCHEME_DBLP(o)) {
      double v = SCHEME_DBL_VAL(o);
      if (MZ_IS_NAN(v))
       return scheme_nan_object;
      else if (v == 0.0) {
       int neg;
       neg = minus_zero_p(v);
       v = (neg ? -1.0 : 1.0);
      }
      if (v > 0)
       return zeroi;
      else
       return scheme_pi;
    } else if (o == zeroi) {
      scheme_raise_exn(MZEXN_FAIL_CONTRACT_DIVIDE_BY_ZERO,
                     "angle: undefined for 0");
      ESCAPED_BEFORE_HERE;
    } else if (scheme_is_positive(o))
      return zeroi;
    else {
# ifdef USE_SINGLE_FLOATS_AS_DEFAULT
      return scheme_single_pi;
# endif
      return scheme_pi;
    }
  }
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object* asin_prim ( int  argc,
Scheme_Object argv[] 
) [static]

Here is the caller graph for this function:

static Scheme_Object* atan_prim ( int  argc,
Scheme_Object argv[] 
) [static]

Here is the caller graph for this function:

static Scheme_Object* bignum_log ( Scheme_Object b) [static]

Definition at line 1468 of file number.c.

{
  Scheme_Object *rem;
  int d_count = 0;
  double d;

  if (!SCHEME_BIGPOS(b))
    return complex_log(b);

  /* Assume that each digit is no bigger than 64 bits: */
  while (SCHEME_BIGLEN(b) >= 15) {
    b = scheme_integer_sqrt_rem(b, &rem);
    d_count++;
  }

  if (SCHEME_BIGNUMP(b))
    d = scheme_bignum_to_double(b);
  else
    d = SCHEME_INT_VAL(b);
  d = log(d);

  while (d_count--) {
    d = d * 2;
  }

  return scheme_make_double(d);
}

Here is the call graph for this function:

static Scheme_Object * bin_lcm ( Scheme_Object n1,
Scheme_Object n2 
) [static]

Definition at line 1100 of file number.c.

{
  Scheme_Object *d, *ret;

  d = scheme_bin_gcd(n1, n2);

  if (scheme_is_zero(d))
    return d;
  
  ret = scheme_bin_mult(n1, scheme_bin_quotient(n2, d));

  return scheme_abs(1, &ret);
}

Here is the call graph for this function:

static Scheme_Object * bitwise_bit_field ( int  argc,
Scheme_Object argv[] 
) [static]

Definition at line 2612 of file number.c.

{
  Scheme_Object *so, *sb1, *sb2;

  so = argv[0];
  sb1 = argv[1];
  sb2 = argv[2];
  if (SCHEME_EXACT_INTEGERP(so)) {
    /* Fast path is when sb1 < sizeof(long), sb2 - sb1 < sizeof(long),
       and argument is positive (though the fixnum negative case is also
       handled here). */
    if (SCHEME_INTP(sb1)) {
      long v1;
      v1 = SCHEME_INT_VAL(sb1);
      if (v1 >= 0) {
        if (SCHEME_INTP(sb2)) {
          long v2;
          v2 = SCHEME_INT_VAL(sb2);
          if (v2 >= v1) {
            v2 -= v1;
            if (v2 < (sizeof(long) * 8)) {
              if (SCHEME_INTP(so)) {
                if (v1 < (sizeof(long) * 8)) {
                  long res;
                  res = ((SCHEME_INT_VAL(so) >> v1) & ((1 << v2) - 1));
                  return scheme_make_integer(res);
                } else if (SCHEME_INT_VAL(so) > 0) 
                  return scheme_make_integer(0);
              } else if (SCHEME_BIGPOS(so)) {
                bigdig d;
                long vd, vb, avail;
                vd = v1 / (sizeof(bigdig) * 8);
                vb = v1 & ((sizeof(bigdig) * 8) - 1);
                if (vd >= ((Scheme_Bignum *)so)->len)
                  return scheme_make_integer(0);
                d = ((Scheme_Bignum *)so)->digits[vd];
                d >>= vb;
                avail = (sizeof(bigdig) * 8) - vb;
                if ((avail < v2)
                    && ((vd + 1) < ((Scheme_Bignum *)so)->len)) {
                  /* Pull in more bits from next digit: */
                  d |= (((Scheme_Bignum *)so)->digits[vd + 1] << avail);
                }
                d = (d & ((1 << v2) - 1));
                return scheme_make_integer(d);
              }
            }
          }
        }
      }
    }
  }

  return slow_bitwise_bit_field(argc, argv, so, sb1, sb2);
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object * bitwise_bit_set_p ( int  argc,
Scheme_Object argv[] 
) [static]

Definition at line 2521 of file number.c.

{
  Scheme_Object *so, *sb;

  so = argv[0];
  if (!SCHEME_EXACT_INTEGERP(so)) {
    scheme_wrong_type("bitwise-bit-set?", "exact integer", 0, argc, argv);
    ESCAPED_BEFORE_HERE;
  }
  sb = argv[1];
  if (SCHEME_INTP(sb)) {
    long v;
    v = SCHEME_INT_VAL(sb);
    if (v < 0) {
      scheme_wrong_type("bitwise-bit-set?", "nonnegative exact integer", 1, argc, argv);
      ESCAPED_BEFORE_HERE;
    }
    if (SCHEME_INTP(so)) {
      if (v < (sizeof(long) * 8))
        return ((((long)1 << v) & SCHEME_INT_VAL(so)) ? scheme_true : scheme_false);
      else
        return ((SCHEME_INT_VAL(so) < 0) ? scheme_true : scheme_false);
    } else {
      bigdig d;
      long vd, vb;
      vd = v / (sizeof(bigdig) * 8);
      vb = v & ((sizeof(bigdig) * 8) - 1);
      if (vd >= ((Scheme_Bignum *)so)->len)
        return (SCHEME_BIGPOS(so) ? scheme_false : scheme_true);
      if (SCHEME_BIGPOS(so)) {
        d = ((Scheme_Bignum *)so)->digits[vd];
        return ((((bigdig)1 << vb) & d) ? scheme_true : scheme_false);
      } else {
        /* Testing a bit in a negative bignum. Just use the slow way for now. */
        Scheme_Object *bit;
        bit = scheme_bignum_shift(scheme_make_bignum(1), v);
        if (SCHEME_INTP(bit))
          bit = scheme_make_bignum(SCHEME_INT_VAL(bit));
        bit = scheme_bignum_and(bit, so);
        return (SAME_OBJ(bit, scheme_make_integer(0)) ? scheme_false : scheme_true);
      }
    }
  } else if (SCHEME_BIGNUMP(sb) && SCHEME_BIGPOS(sb)) {
    if (SCHEME_INTP(so))
      return ((SCHEME_INT_VAL(so) < 0) ? scheme_true : scheme_false);
    else
      return (SCHEME_BIGPOS(so) ? scheme_false : scheme_true);
  } else {
    scheme_wrong_type("bitwise-bit-set?", "nonnegative exact integer", 1, argc, argv);
    ESCAPED_BEFORE_HERE;
  }
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object * bitwise_not ( int  argc,
Scheme_Object argv[] 
) [static]

Definition at line 2445 of file number.c.

{
  Scheme_Object *o = argv[0];

  if (SCHEME_INTP(o)) {
    long a = SCHEME_INT_VAL(o);

    a = ~a;
    return scheme_make_integer(a);
  } else if (_SCHEME_TYPE(o) == scheme_bignum_type)
    return scheme_bignum_not(o);
   
  scheme_wrong_type("bitwise-not", "exact integer", 0, argc, argv);
  ESCAPED_BEFORE_HERE;
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object* bitwise_or ( int  argc,
Scheme_Object argv[] 
) [static]

Here is the caller graph for this function:

static Scheme_Object* bitwise_xor ( int  argc,
Scheme_Object argv[] 
) [static]

Here is the caller graph for this function:

static Scheme_Object * ceiling ( int  argc,
Scheme_Object argv[] 
) [static]

Definition at line 1144 of file number.c.

{
  Scheme_Object *o = argv[0];
  Scheme_Type t;

  if (SCHEME_INTP(o))
    return o;
  t = _SCHEME_TYPE(o);
#ifdef MZ_USE_SINGLE_FLOATS
  if (t == scheme_float_type) {
    float d = SCHEME_FLT_VAL(o);
    return scheme_make_float(ceil(d));
  }
#endif
  if (t == scheme_double_type) {
    double d = SCHEME_DBL_VAL(o);
    return scheme_make_double(ceil(d));
  }
  if (t == scheme_bignum_type)
    return o;
  if (t == scheme_rational_type)
    return scheme_rational_ceiling(o);

  NEED_REAL(ceiling);

  ESCAPED_BEFORE_HERE;
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object * complex_acos ( Scheme_Object c) [static]

Definition at line 1547 of file number.c.

Here is the call graph for this function:

static Scheme_Object * complex_asin ( Scheme_Object c) [static]

Definition at line 1532 of file number.c.

{
  Scheme_Object *one_minus_c_sq, *sqrt_1_minus_c_sq;

  one_minus_c_sq = scheme_bin_minus(scheme_make_integer(1),
                                scheme_bin_mult(c, c));
  sqrt_1_minus_c_sq = scheme_sqrt(1, &one_minus_c_sq);
  return scheme_bin_mult(scheme_make_integer(2),
                         complex_atan(scheme_bin_div(c,
                                                     scheme_bin_plus(scheme_make_integer(1),
                                                                     sqrt_1_minus_c_sq))));
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object * complex_atan ( Scheme_Object c) [static]

Definition at line 1566 of file number.c.

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object * complex_cos ( Scheme_Object c) [static]

Definition at line 1511 of file number.c.

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object * complex_exp ( Scheme_Object c) [static]

Definition at line 1443 of file number.c.

{
  Scheme_Object *r = _scheme_complex_real_part(c);
  Scheme_Object *i = _scheme_complex_imaginary_part(c);
  Scheme_Object *cos_a, *sin_a;

  r = exp_prim(1, &r);
  cos_a = cos_prim(1, &i);
  sin_a = sin_prim(1, &i);

  return scheme_bin_mult(r, scheme_bin_plus(cos_a, scheme_bin_mult(sin_a, scheme_plus_i)));
}

Here is the call graph for this function:

static Scheme_Object * complex_log ( Scheme_Object c) [static]

Definition at line 1458 of file number.c.

{
  Scheme_Object *m, *theta;

  m = magnitude(1, &c);
  theta = angle(1, &c);

  return scheme_bin_plus(log_prim(1, &m), scheme_bin_mult(scheme_plus_i, theta));
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object * complex_p ( int  argc,
Scheme_Object argv[] 
) [static]

Definition at line 763 of file number.c.

{
  Scheme_Object *o = argv[0];
  return (SCHEME_NUMBERP(o) ? scheme_true : scheme_false);
}

Here is the caller graph for this function:

static Scheme_Object * complex_sin ( Scheme_Object c) [static]

Definition at line 1498 of file number.c.

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object * complex_tan ( Scheme_Object c) [static]

Definition at line 1524 of file number.c.

Here is the call graph for this function:

static Scheme_Object* cos_prim ( int  argc,
Scheme_Object argv[] 
) [static]

Here is the caller graph for this function:

static Scheme_Object * denominator ( int  argc,
Scheme_Object argv[] 
) [static]

Definition at line 1436 of file number.c.

{
  return get_frac("denominator", 1, argc, argv);
}

Here is the call graph for this function:

Here is the caller graph for this function:

Scheme_Object* do_int_sqrt ( const char *  name,
int  argc,
Scheme_Object argv[],
int  w_rem 
)

Definition at line 1822 of file number.c.

{
  Scheme_Object *v = argv[0], *rem = NULL;

  if (!scheme_is_integer(v)) {
    scheme_wrong_type(name, "integer", 0, argc, argv);
    return NULL;
  }

  if (SCHEME_INTP(v) || SCHEME_BIGNUMP(v)) {
    int imaginary = 0;
    
    if (scheme_is_negative(v)) {
      v = scheme_bin_minus(zeroi, v);
      imaginary = 1;
    }

    v = scheme_integer_sqrt_rem(v, &rem);

    if (imaginary) {
      v = scheme_make_complex(zeroi, v);
      rem = scheme_bin_minus(zeroi, rem);
    }
  } else {
    /* Must be inexact. Compose normal sqrt and floor, which should
       handle infinities and NAN just fine. */
    rem = v;
    v = scheme_sqrt(1, &v);
    if (SCHEME_COMPLEXP(v)) {
      v = scheme_complex_imaginary_part(v);
      v = floor_prim(1, &v);
      v = scheme_make_complex(scheme_make_integer(0), v);
    } else
      v = floor_prim(1, &v);
    
    if (w_rem) {
      rem = scheme_bin_minus(rem, scheme_bin_mult(v, v));
    }
  }

  if (w_rem) {
    Scheme_Object *a[2];
    a[0] = v;
    a[1] = rem;
    return scheme_values(2, a);
  } else
    return v;
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object * even_p ( int  argc,
Scheme_Object argv[] 
) [static]

Definition at line 965 of file number.c.

{
  Scheme_Object *v = argv[0];

  if (SCHEME_INTP(v))
    return (SCHEME_INT_VAL(v) & 0x1) ? scheme_false : scheme_true;
  if (SCHEME_BIGNUMP(v))
    return (SCHEME_BIGDIG(v)[0] & 0x1) ? scheme_false : scheme_true;

  if (scheme_is_integer(v)) {
    double d = SCHEME_FLOAT_VAL(v);
    if (MZ_IS_INFINITY(d))
      return scheme_true;
    return (fmod(d, 2.0) == 0.0) ? scheme_true : scheme_false;
  }

  NEED_INTEGER(even?);

  ESCAPED_BEFORE_HERE;
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object * exact_integer_p ( int  argc,
Scheme_Object argv[] 
) [static]

Definition at line 816 of file number.c.

{
  Scheme_Object *n = argv[0];
  if (SCHEME_INTP(n))
    return scheme_true;
  else if (SCHEME_BIGNUMP(n))
    return scheme_true;
  else
    return scheme_false;
}

Here is the caller graph for this function:

static Scheme_Object * exact_nonnegative_integer_p ( int  argc,
Scheme_Object argv[] 
) [static]

Definition at line 828 of file number.c.

{
  Scheme_Object *n = argv[0];
  if (SCHEME_INTP(n))
    return ((SCHEME_INT_VAL(n) >= 0) ? scheme_true : scheme_false);
  else if (SCHEME_BIGNUMP(n))
    return (SCHEME_BIGPOS(n) ? scheme_true : scheme_false);
  else
    return scheme_false;
}

Here is the caller graph for this function:

Scheme_Object * exact_p ( int  argc,
Scheme_Object argv[] 
) [static]

Definition at line 895 of file number.c.

{
  int v;
  v = scheme_is_exact(argv[0]);
  if (v < 0) {
    scheme_wrong_type("exact?", "number", 0, argc, argv);
    ESCAPED_BEFORE_HERE;
  }
  return (v ? scheme_true : scheme_false);
}

Here is the caller graph for this function:

static Scheme_Object * exact_positive_integer_p ( int  argc,
Scheme_Object argv[] 
) [static]

Definition at line 840 of file number.c.

{
  Scheme_Object *n = argv[0];
  if (SCHEME_INTP(n))
    return ((SCHEME_INT_VAL(n) > 0) ? scheme_true : scheme_false);
  else if (SCHEME_BIGNUMP(n))
    return (SCHEME_BIGPOS(n) ? scheme_true : scheme_false);
  else
    return scheme_false;
}

Here is the caller graph for this function:

static Scheme_Object* exp_prim ( int  argc,
Scheme_Object argv[] 
) [static]

Here is the caller graph for this function:

static Scheme_Object * fixnum_expt ( long  x,
long  y 
) [static]

Definition at line 1881 of file number.c.

{
  int orig_x = x;
  int orig_y = y;

  if ((x == 2) && (y <= MAX_SHIFT_TRY))
    return scheme_make_integer((long)1 << y);
  else
  {
    long result = 1;
    int odd_result = (x < 0) && (y & 0x1);

    if (x < 0)
      x = -x;
    while (y > 0)
    {
      /* x^y*result is invariant and result <= x */
      if (x > 46339 && y > 1) /* x * x won't fit in 31 bits */
        return scheme_generic_integer_power(scheme_make_integer_value(orig_x), scheme_make_integer_value(orig_y));

      if (y & 0x1) /* if (odd?) */
      {
        long next_result = x * result;
        if (y == 1 && x > 46339 && !(next_result / x == result))
          return scheme_generic_integer_power(scheme_make_integer_value(orig_x), scheme_make_integer_value(orig_y));
        else
          result = next_result;
      }
      y = y >> 1;
      x = x * x;
    }
    return scheme_make_integer_value(odd_result ? -result : result);
  }
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object * fixnum_p ( int  argc,
Scheme_Object argv[] 
) [static]

Definition at line 852 of file number.c.

{
  Scheme_Object *n = argv[0];
  if (SCHEME_INTP(n))
    return scheme_true;
  else
    return scheme_false;
}

Here is the caller graph for this function:

static Scheme_Object * floor_prim ( int  argc,
Scheme_Object argv[] 
) [static]

Definition at line 1115 of file number.c.

{
  Scheme_Object *o = argv[0];
  Scheme_Type t;

  if (SCHEME_INTP(o))
    return o;
  t = _SCHEME_TYPE(o);
#ifdef MZ_USE_SINGLE_FLOATS
  if (t == scheme_float_type) {
    float d = SCHEME_FLT_VAL(o);
    return scheme_make_float(floor(d));
  }
#endif
  if (t == scheme_double_type) {
    double d = SCHEME_DBL_VAL(o);
    return scheme_make_double(floor(d));
  }
  if (t == scheme_bignum_type)
    return o;
  if (t == scheme_rational_type)
    return scheme_rational_floor(o);

  NEED_REAL(floor);

  ESCAPED_BEFORE_HERE;
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object* gcd ( int  argc,
Scheme_Object argv[] 
) [static]

Here is the caller graph for this function:

Definition at line 1979 of file number.c.

{
  int invert = 0;
  Scheme_Object *e, *r, *n;

  n = argv[0];
  e = argv[1];

  if (!SCHEME_NUMBERP(n))
    scheme_wrong_type("expt", "number", 0, argc, argv);

  if (e == zeroi)
    return scheme_make_integer(1);
  if (e == scheme_exact_one)
    return n;
  if (n == scheme_exact_one) {
    /* Power of one: */
    if (SCHEME_NUMBERP(e))
      return n;
  }
  if (SCHEME_RATIONALP(e)
      && (((Scheme_Rational *)e)->num == scheme_exact_one)
      && (((Scheme_Rational *)e)->denom == scheme_make_integer(2))) {
    return scheme_sqrt(1, argv);
  }

  if (n == zeroi) {
    /* Power of exact zero */
    int neg;

    if (SCHEME_FLOATP(e)) {
      double d = SCHEME_FLOAT_VAL(e);
      if (MZ_IS_NAN(d)) {
#ifdef MZ_USE_SINGLE_FLOATS
       if (SCHEME_FLTP(e))
         return scheme_single_nan_object;
#endif
       return scheme_nan_object;
      }
    }

    if (!SCHEME_COMPLEXP(e)) {
      neg = scheme_is_negative(e);
    } else {
      neg = !scheme_is_positive(scheme_complex_real_part(e));
    }
    
    if (neg) {
      scheme_raise_exn(MZEXN_FAIL_CONTRACT_DIVIDE_BY_ZERO,
                     "expt: undefined for 0 and %s",
                     scheme_make_provided_string(e, 0, NULL));
      ESCAPED_BEFORE_HERE;
    }
  }

  if (!SCHEME_FLOATP(n)) {
    /* negative integer power of exact: compute positive power and invert */
    if (SCHEME_INTP(e) || SCHEME_BIGNUMP(e)) {
      if (!scheme_is_positive(e)) {
       e = scheme_bin_minus(zeroi, e);
       invert = 1;
      }
    }
  } else {
    /* real power of inexact zero? */
    /* (Shouldn't have to do this, but pow() is especially unreliable.) */
    double d = SCHEME_FLOAT_VAL(n);
    if ((d == 0.0)
#ifdef NAN_EQUALS_ANYTHING
       && !MZ_IS_NAN(d)
#endif
       ) {
      if (SCHEME_REALP(e)) {
       int norm = 0;

       if (SCHEME_FLOATP(e)) {
         double d2;
         d2 = SCHEME_FLOAT_VAL(e);
         
         if ((d2 == 0.0)
             || MZ_IS_INFINITY(d2)
             || MZ_IS_NAN(d2))
           norm = 1;
       }

       if (!norm) {
         int isnonneg, iseven, negz;
#ifdef MZ_USE_SINGLE_FLOATS
         int single = !SCHEME_DBLP(n) && !SCHEME_DBLP(e);
#endif

         if (scheme_is_integer(e)) {
           iseven = SCHEME_FALSEP(scheme_odd_p(1, &e));
         } else {
           /* Treat it as even for sign purposes: */
           iseven = 1;
         }
         isnonneg = !scheme_is_negative(e);
         negz = scheme_minus_zero_p(d);

         if (isnonneg) {
           if (iseven || !negz) {
#ifdef MZ_USE_SINGLE_FLOATS
             if (single)
              return scheme_zerof;
#endif
             return scheme_zerod;
           } else {
#ifdef MZ_USE_SINGLE_FLOATS
             if (single)
              return scheme_nzerof;
#endif
             return scheme_nzerod;
           }
         } else {
           if (iseven || !negz) {
#ifdef MZ_USE_SINGLE_FLOATS
             if (single)
              return scheme_single_inf_object;
#endif
             return scheme_inf_object;
           } else {
#ifdef MZ_USE_SINGLE_FLOATS
             if (single)
              return scheme_single_minus_inf_object;
#endif
             return scheme_minus_inf_object;
           }
         }
       }
      }
    }
  }

  r = bin_expt(argv[0], e);
  if (invert)
    r = scheme_bin_div(scheme_make_integer(1), r);

  return r;
}

Here is the call graph for this function:

GEN_BIN_PROT ( bin_expt  )
GEN_BIN_PROT ( bin_bitwise_and  )
GEN_BIN_PROT ( bin_bitwise_or  )
GEN_BIN_PROT ( bin_bitwise_xor  )
GEN_UNARY_OP ( log_prim  ,
log  ,
SCH_LOG  ,
scheme_inf_object  ,
scheme_single_inf_object  ,
scheme_inf_plus_pi()  ,
scheme_single_inf_plus_pi()  ,
scheme_nan_object  ,
scheme_single_nan_object  ,
complex_log  ,
GEN_ONE_IS_ZERO_AND_ZERO_IS_ERR  ,
NEGATIVE_USES_COMPLEX  ,
BIGNUM_LOG   
)

Definition at line 1636 of file number.c.

{
  double v;
  Scheme_Object *n1;
#ifdef MZ_USE_SINGLE_FLOATS
# ifdef USE_SINGLE_FLOATS_AS_DEFAULT
  int dbl = 0;
# define MZ_USE_SINGLE !dbl
# else
  int single = 0;
# define MZ_USE_SINGLE single == 2
#endif
#endif

  n1 = argv[0];

  if (SCHEME_INTP(n1))
    v = SCHEME_INT_VAL(n1);
#ifdef MZ_USE_SINGLE_FLOATS
  else if (SCHEME_FLTP(n1)) {
    v = SCHEME_FLT_VAL(n1);
# ifndef USE_SINGLE_FLOATS_AS_DEFAULT
    single++;
# endif
  }
#endif
  else if (SCHEME_DBLP(n1)) {
# ifdef USE_SINGLE_FLOATS_AS_DEFAULT
    dbl++;
# endif
    v = SCHEME_DBL_VAL(n1);
  } else if (SCHEME_BIGNUMP(n1))
    v = scheme_bignum_to_double(n1);
  else if (SCHEME_RATIONALP(n1))
    v = scheme_rational_to_double(n1);
  else if (SCHEME_COMPLEXP(n1)) {
    if (argc > 1) {
      scheme_wrong_type("atan (with two arguments)", REAL_NUMBER_STR, 0, argc, argv);
      ESCAPED_BEFORE_HERE;
    } else
      return complex_atan(n1);
  } else {
    NEED_NUMBER(atan);
    ESCAPED_BEFORE_HERE;
  }

  if (argc == 2) {
    double v2;
    Scheme_Object *n2;
    
    n2 = argv[1];

    if ((n1 == zeroi) && (n2 == zeroi)) {
      scheme_raise_exn(MZEXN_FAIL_CONTRACT_DIVIDE_BY_ZERO,
                     "atan: undefined for 0 and 0");
      ESCAPED_BEFORE_HERE;
    }

    if (SCHEME_INTP(n2))
      v2 = SCHEME_INT_VAL(n2);
#ifdef MZ_USE_SINGLE_FLOATS
    else if (SCHEME_FLTP(n2)) {
      v2 = SCHEME_FLT_VAL(n2);
# ifndef USE_SINGLE_FLOATS_AS_DEFAULT
      single++;
# endif
    }
#endif
    else if (SCHEME_DBLP(n2)) {
# ifdef USE_SINGLE_FLOATS_AS_DEFAULT
      dbl++;
# endif
      v2 = SCHEME_DBL_VAL(n2);
    } else if (SCHEME_BIGNUMP(n2))
      v2 = scheme_bignum_to_double(n2);
    else if (SCHEME_RATIONALP(n2))
      v2 = scheme_rational_to_double(n2);
    else {
      scheme_wrong_type("atan", REAL_NUMBER_STR, 1, argc, argv);
      ESCAPED_BEFORE_HERE;
    }

    if ((v == 0.0) && (v2 == 0.0)) {
#ifdef MZ_USE_SINGLE_FLOATS
      if (MZ_USE_SINGLE)
       return scheme_zerof;
#endif      
      return scheme_zerod;
    }

#ifdef ATAN2_DOESNT_WORK_WITH_INFINITIES
    if (MZ_IS_INFINITY(v) && MZ_IS_INFINITY(v2)) {
      v = MZ_IS_POS_INFINITY(v) ? 1.0 : -1.0;
      v2 = MZ_IS_POS_INFINITY(v2) ? 1.0 : -1.0;
    }
#endif
#ifdef ATAN2_DOESNT_WORK_WITH_NAN
    if (MZ_IS_NAN(v) || MZ_IS_NAN(v2))
      return scheme_nan_object;
#endif

    v = atan2(v, v2);
  } else {
    if (argv[0] == zeroi)
      return zeroi;

#ifdef TRIG_ZERO_NEEDS_SIGN_CHECK
    if (v == 0.0) {
      /* keep v the same */
    } else
#endif
      v = atan(v);

#ifdef MZ_USE_SINGLE_FLOATS
# ifndef USE_SINGLE_FLOATS_AS_DEFAULT
    single++;
# endif
#endif    
  }

#ifdef MZ_USE_SINGLE_FLOATS
  if (MZ_USE_SINGLE)
    return scheme_make_float((float)v);
#endif

  return scheme_make_double(v);

#undef MZ_USE_SINGLE
}

Here is the call graph for this function:

static Scheme_Object* get_frac ( char *  name,
int  low_p,
int  argc,
Scheme_Object argv[] 
) [static]

Definition at line 1372 of file number.c.

{
  Scheme_Object *n = argv[0], *orig;

  orig = n;

  if (SCHEME_FLOATP(n)) {
    double d = SCHEME_FLOAT_VAL(n);
    
    if (MZ_IS_NAN(d)
        || MZ_IS_INFINITY(d)) {
      scheme_wrong_type(name, "rational number", 0, argc, argv);
      ESCAPED_BEFORE_HERE;
    }
    
#ifdef MZ_USE_SINGLE_FLOATS
    if (SCHEME_FLTP(n))
      n = scheme_rational_from_float((float)d);
    else
#endif
      n = scheme_rational_from_double(d);
  }
  
  if (SCHEME_INTP(n) || SCHEME_BIGNUMP(n))
    n = low_p ? scheme_make_integer(1) : n;
  else if (SCHEME_RATIONALP(n)) {
    if (low_p)
      n = scheme_rational_denominator(n);
    else
      n = scheme_rational_numerator(n);
  } else {
    scheme_wrong_type(name, "rational number", 0, argc, argv);
    ESCAPED_BEFORE_HERE;   
  }
  
  if (SCHEME_DBLP(orig))
    return TO_DOUBLE(n);
#ifdef MZ_USE_SINGLE_FLOATS
  if (SCHEME_FLTP(orig))
    return TO_FLOAT(n);
#endif
  else
    return n;
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object * imag_part ( int  argc,
Scheme_Object argv[] 
) [static]

Definition at line 2186 of file number.c.

{
  Scheme_Object *o = argv[0];

  if (!SCHEME_NUMBERP(o))
    scheme_wrong_type("imag-part", "number", 0, argc, argv);

  if (SCHEME_COMPLEXP(o))
    return scheme_complex_imaginary_part(o);

  return zeroi;
}

Here is the caller graph for this function:

static Scheme_Object * inexact_real_p ( int  argc,
Scheme_Object argv[] 
) [static]

Definition at line 862 of file number.c.

{
  Scheme_Object *n = argv[0];
  if (SCHEME_FLOATP(n))
    return scheme_true;
  else
    return scheme_false;
}

Here is the caller graph for this function:

static Scheme_Object* int_abs ( Scheme_Object v) [static]

Definition at line 988 of file number.c.

{
  if (scheme_is_negative(v))
    return scheme_bin_minus(scheme_make_integer(0), v);
  else
    return v;
}

Here is the call graph for this function:

Scheme_Object * int_sqrt ( int  argc,
Scheme_Object argv[] 
) [static]

Definition at line 1871 of file number.c.

{
  return do_int_sqrt("integer-sqrt", argc, argv, 0);
}

Here is the call graph for this function:

Here is the caller graph for this function:

Scheme_Object * int_sqrt_rem ( int  argc,
Scheme_Object argv[] 
) [static]

Definition at line 1876 of file number.c.

{
  return do_int_sqrt("integer-sqrt/remainder", argc, argv, 1);
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object * integer_length ( int  argc,
Scheme_Object argv[] 
) [static]

Definition at line 2669 of file number.c.

{
  Scheme_Object *o = argv[0];
  unsigned long n;
  int base;

  if (SCHEME_INTP(o)) {
    long a = SCHEME_INT_VAL(o);

    if (a < 0)
      a = ~a;
    
    n = a;
    base = 0;
  } else if (_SCHEME_TYPE(o) == scheme_bignum_type) {
    bigdig d;

    if (!SCHEME_BIGPOS(o)) {
      /* Maybe we could do better... */
      o = scheme_bignum_not(o);
    }

    base = ((Scheme_Bignum *)o)->len;
    d = ((Scheme_Bignum *)o)->digits[base - 1];
    base = (base - 1) * (sizeof(bigdig) * 8);

#ifdef USE_LONG_LONG_FOR_BIGDIG
    n = (unsigned long)d;
    if ((bigdig)n != d) {
      /* Must have been overflow */
      d >>= (sizeof(unsigned long) * 8);
      base += (sizeof(unsigned long) * 8);
      n = (unsigned long)d;
    }
#else
    n = d;
#endif
  } else {
    scheme_wrong_type("integer-length", "exact integer", 0, argc, argv);
    ESCAPED_BEFORE_HERE;
  }

  while (n) {
    n >>= 1;
    base++;
  }

  return scheme_make_integer(base);
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object * integer_p ( int  argc,
Scheme_Object argv[] 
) [static]

Definition at line 810 of file number.c.

{
  return scheme_is_integer(argv[0]) ? scheme_true : scheme_false;
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object* lcm ( int  argc,
Scheme_Object argv[] 
) [static]

Here is the caller graph for this function:

static Scheme_Object* log_prim ( int  argc,
Scheme_Object argv[] 
) [static]

Here is the caller graph for this function:

static Scheme_Object * magnitude ( int  argc,
Scheme_Object argv[] 
) [static]

Definition at line 2199 of file number.c.

{
  Scheme_Object *o = argv[0];

  if (!SCHEME_NUMBERP(o))
    scheme_wrong_type("magnitude", "number", 0, argc, argv);

  if (SCHEME_COMPLEXP(o)) {
    Scheme_Object *r = _scheme_complex_real_part(o);
    Scheme_Object *i = _scheme_complex_imaginary_part(o);
    Scheme_Object *a[1], *q;
    a[0] = r;
    r = scheme_abs(1, a);
    a[0] = i;
    i = scheme_abs(1, a);
    
    if (SAME_OBJ(r, scheme_make_integer(0)))
      return i;

    if (scheme_bin_lt(i, r)) {
      Scheme_Object *tmp;
      tmp = i;
      i = r;
      r = tmp;
    }
    if (scheme_is_zero(r)) {
      a[0] = i;
      return scheme_exact_to_inexact(1, a);
    }
    if (SCHEME_FLOATP(i)) {
      double d;
      d = SCHEME_FLOAT_VAL(i);
      if (MZ_IS_POS_INFINITY(d)) {
        if (SCHEME_FLOATP(r)) {
          d = SCHEME_FLOAT_VAL(r);
          if (MZ_IS_NAN(d))
            return scheme_nan_object;
        }
        return scheme_inf_object;
      }
    }
    q = scheme_bin_div(r, i);
    q = scheme_bin_plus(scheme_make_integer(1),
                     scheme_bin_mult(q, q));
    a[0] = q;
    return scheme_bin_mult(i, scheme_sqrt(1, a));
  } else
    return scheme_abs(1, argv);
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object * make_rectangular ( int  argc,
Scheme_Object argv[] 
) [static]

Definition at line 2124 of file number.c.

{
  Scheme_Object *a, *b;
  int af, bf;

  a = argv[0];
  b = argv[1];
  if (!SCHEME_REALP(a))
    scheme_wrong_type("make-rectangular", REAL_NUMBER_STR, 0, argc, argv);
  if (!SCHEME_REALP(b))
    scheme_wrong_type("make-rectangular", REAL_NUMBER_STR, 1, argc, argv);

  af = SCHEME_FLOATP(a);
  bf = SCHEME_FLOATP(b);

  if (af && !bf) {
    if (b != zeroi)
      b = scheme_exact_to_inexact(1, &b);
  }
  if (bf && !af) {
    if (a != zeroi)
      a = scheme_exact_to_inexact(1, &a);
  }

  return scheme_make_complex(a, b);
}

Here is the call graph for this function:

Here is the caller graph for this function:

static XFORM_NONGCING MZ_INLINE int minus_zero_p ( double  d) [static]

Definition at line 668 of file number.c.

{
  return (1 / d) < 0;
}

Here is the caller graph for this function:

static Scheme_Object * number_p ( int  argc,
Scheme_Object argv[] 
) [static]

Definition at line 756 of file number.c.

{
  Scheme_Object *o = argv[0];
  return (SCHEME_NUMBERP(o) ? scheme_true : scheme_false);
}

Here is the caller graph for this function:

static Scheme_Object * numerator ( int  argc,
Scheme_Object argv[] 
) [static]

Definition at line 1431 of file number.c.

{
  return get_frac("numerator", 0, argc, argv);
}

Here is the call graph for this function:

Here is the caller graph for this function:

static int rational_dbl_p ( double  f) [static]

Definition at line 685 of file number.c.

                                    {
  return !(MZ_IS_NAN(f)
           || MZ_IS_INFINITY(f));
}

Here is the caller graph for this function:

static Scheme_Object * rational_p ( int  argc,
Scheme_Object argv[] 
) [static]

Definition at line 777 of file number.c.

{
  Scheme_Object *o = argv[0];

  if (SCHEME_FLOATP(o))
    return (rational_dbl_p(SCHEME_FLOAT_VAL(o)) ? scheme_true : scheme_false);
  else
    return (SCHEME_REALP(o) ? scheme_true : scheme_false);
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object * real_p ( int  argc,
Scheme_Object argv[] 
) [static]

Definition at line 770 of file number.c.

{
  Scheme_Object *o = argv[0];
  return (SCHEME_REALP(o) ? scheme_true : scheme_false);
}

Here is the caller graph for this function:

static Scheme_Object * real_part ( int  argc,
Scheme_Object argv[] 
) [static]

Definition at line 2173 of file number.c.

{
  Scheme_Object *o = argv[0];

  if (!SCHEME_NUMBERP(o))
    scheme_wrong_type("real-part", "number", 0, argc, argv);

  if (SCHEME_COMPLEXP(o))
    return _scheme_complex_real_part(o);
  else
    return argv[0];
}

Here is the caller graph for this function:

static double sch_pow ( double  x,
double  y 
) [static]

Definition at line 1919 of file number.c.

{
  if (MZ_IS_POS_INFINITY(y)) {
    if ((x == 1.0) || (x == -1.0))
      return not_a_number_val;
    else if ((x < 1.0) && (x > -1.0))
      return 0.0;
    else
      return scheme_infinity_val;
  } else if (MZ_IS_NEG_INFINITY(y)) {
    if ((x == 1.0) || (x == -1.0))
      return not_a_number_val;
    else if ((x < 1.0) && (x > -1.0))
      return scheme_infinity_val;
    else
      return 0.0;
  } else if (MZ_IS_POS_INFINITY(x)) {
    if (y == 0.0)
      return 1.0;
    else if (y < 0)
      return 0.0;
    else
      return scheme_infinity_val;
  } else if (MZ_IS_NEG_INFINITY(x)) {
    if (y == 0.0)
      return 1.0;
    else {
      int neg = 0;
      if (y < 0) {
       neg = 1;
       y = -y;
      }
      if (fmod(y, 2.0) == 1.0) {
       if (neg)
         return scheme_floating_point_nzero;
       else
         return scheme_minus_infinity_val;
      } else {
       if (neg)
         return 0.0;
       else
         return scheme_infinity_val;
      }
    }
  } else
    return pow(x, y);
}
static Scheme_Object * sch_round ( int  argc,
Scheme_Object argv[] 
) [static]

Definition at line 1210 of file number.c.

{
  Scheme_Object *o = argv[0];
  Scheme_Type t;

  if (SCHEME_INTP(o))
    return o;
  t = _SCHEME_TYPE(o);
#ifdef MZ_USE_SINGLE_FLOATS
  if (t == scheme_float_type) {
    double d = SCHEME_FLT_VAL(o);
    double i, frac;
    int invert;

    if (d < 0) {
      d = -d;
      invert = 1;
    } else
      invert = 0;

    frac = modf(d, &i);
    if (frac < 0.5)
      d = i;
    else if (frac > 0.5)
      d = i + 1;
    else if (fmod(i, 2.0) != 0.0)
      d = i + 1;
    else
      d = i;

    if (invert)
      d = -d;

    return scheme_make_float((float)d);
  }
#endif
  if (t == scheme_double_type) {
    double d = SCHEME_DBL_VAL(o);
    double i, frac;
    int invert;

#ifdef FMOD_CAN_RETURN_POS_ZERO
    if ((d == 0.0) && minus_zero_p(d))
      return o;
#endif

    if (d < 0) {
      d = -d;
      invert = 1;
    } else
      invert = 0;

    frac = modf(d, &i);
    if (frac < 0.5)
      d = i;
    else if (frac > 0.5)
      d = i + 1;
    else if (fmod(i, 2.0) != 0.0)
      d = i + 1;
    else
      d = i;

    if (invert)
      d = -d;

    return scheme_make_double(d);
  }
  if (t == scheme_bignum_type)
    return o;
  if (t == scheme_rational_type)
    return scheme_rational_round(o);

  NEED_REAL(round);

  ESCAPED_BEFORE_HERE;
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object * sch_truncate ( int  argc,
Scheme_Object argv[] 
) [static]

Definition at line 1173 of file number.c.

{
  Scheme_Object *o = argv[0];
  Scheme_Type t;

  if (SCHEME_INTP(o))
    return o;
  t = _SCHEME_TYPE(o);
#ifdef MZ_USE_SINGLE_FLOATS
  if (t == scheme_float_type) {
    float v = SCHEME_FLT_VAL(o);
    if (v > 0)
      v = floor(v);
    else
      v = ceil(v);
    return scheme_make_float(v);
  }
#endif
  if (t == scheme_double_type) {
    double v = SCHEME_DBL_VAL(o);
    if (v > 0)
      v = floor(v);
    else
      v = ceil(v);
    return scheme_make_double(v);
  }
  if (t == scheme_bignum_type)
    return o;
  if (t == scheme_rational_type)
    return scheme_rational_truncate(o);

  NEED_REAL(truncate);

  ESCAPED_BEFORE_HERE;
}

Here is the call graph for this function:

Here is the caller graph for this function:

Definition at line 1000 of file number.c.

{
  if (SCHEME_INTP(n1) && SCHEME_INTP(n2)) {
    long i1, i2, a, b, r;

    i1 = SCHEME_INT_VAL(n1);
    i2 = SCHEME_INT_VAL(n2);
    if (i1 < 0)
      i1 = -i1;
    if (i2 < 0)
      i2 = -i2;
    if (i1 > i2) {
      a = i1;
      b = i2;
    } else {
      a = i2;
      b = i1;
    }
    
    while (b > 0) {
      r = a % b;
      a = b;
      b = r;
    }
    return (scheme_make_integer(a));
  } else if (SCHEME_FLOATP(n1) || SCHEME_FLOATP(n2)) {
    double i1, i2, a, b, r;
#ifdef MZ_USE_SINGLE_FLOATS
# ifdef USE_SINGLE_FLOATS_AS_DEFAULT
    int was_single = !(SCHEME_DBLP(n1) || SCHEME_DBLP(n2));
# else
    int was_single = (SCHEME_FLTP(n1) || SCHEME_FLTP(n2));
# endif
#endif

    if (SCHEME_INTP(n1))
      i1 = SCHEME_INT_VAL(n1);
    else if (SCHEME_FLOATP(n1))
      i1 = SCHEME_FLOAT_VAL(n1);
    else
      i1 = scheme_bignum_to_double(n1);

    if (SCHEME_INTP(n2))
      i2 = SCHEME_INT_VAL(n2);
    else if (SCHEME_FLOATP(n2))
      i2 = SCHEME_FLOAT_VAL(n2);
    else
      i2 = scheme_bignum_to_double(n2);

    if (i1 < 0)
      i1 = -i1;
    if (i2 < 0)
      i2 = -i2;
    if (i1 > i2) {
      a = i1;
      b = i2;
    } else {
      a = i2;
      b = i1;
    }

#if 0
    /* Shouldn't happen, since +nan.0 isn't an integer */
    if (MZ_IS_NAN(a) || MZ_IS_NAN(b))
      return nan_object;
#endif
    if (MZ_IS_POS_INFINITY(a)) {
#ifdef MZ_USE_SINGLE_FLOATS
      if (was_single)
       return scheme_make_float((float)b);
#endif
      return scheme_make_double(b);
    }
    
    while (b > 0) {
      r = fmod(a, b);
      a = b;
      b = r;
    }

#ifdef MZ_USE_SINGLE_FLOATS
    if (was_single)
      return scheme_make_float((float)a);
#endif

    return scheme_make_double(a);
  } else {
    n1 = scheme_to_bignum(n1);
    n2 = scheme_to_bignum(n2);

    if (!SCHEME_BIGPOS(n1))
      n1 = scheme_bignum_negate(n1);
    if (!SCHEME_BIGPOS(n2))
      n2 = scheme_bignum_negate(n2);

    return scheme_bignum_gcd(n1, n2);
  }
}

Here is the call graph for this function:

Here is the caller graph for this function:

Definition at line 2462 of file number.c.

{
  Scheme_Object *v, *so;
  long shift;

  v = argv[0];
  
  if (!SCHEME_EXACT_INTEGERP(v)) {
    scheme_wrong_type("arithmetic-shift", "exact integer", 0, argc, argv);
    ESCAPED_BEFORE_HERE;
  }
  so = argv[1];
  if (!SCHEME_INTP(so)) {
    if (SCHEME_BIGNUMP(so)) {
      if (!SCHEME_BIGPOS(so)) {
       if (scheme_is_negative(v))
         return scheme_make_integer(-1);
       else
         return scheme_make_integer(0);
      } else
       scheme_raise_out_of_memory("arithmetic-shift", NULL);
    } else
      scheme_wrong_type("arithmetic-shift", "exact integer", 1, argc, argv);
    ESCAPED_BEFORE_HERE;
  }
  
  shift = SCHEME_INT_VAL(so);
  if (!shift)
    return v;

  if (SCHEME_INTP(v)) {
    long i = SCHEME_INT_VAL(v);

    if (!i)
      return v;

    if (i > 0) {
      if (shift < 0) {
       int shft = -shift;
       if (shft < MAX_SHIFT_EVER) {
         i = i >> shft;
         return scheme_make_integer(i);
       } else
         return scheme_make_integer(0);
      } else if (shift <= MAX_SHIFT_TRY) {
       long n;
       
       n = i << shift;
       if ((n > 0) && (SCHEME_INT_VAL(scheme_make_integer(n)) >> shift == i))
         return scheme_make_integer(n);
      }
    }

    v = scheme_make_bignum(i);
  }

  return scheme_bignum_shift(v, shift);
}

Here is the call graph for this function:

Here is the caller graph for this function:

Definition at line 2325 of file number.c.

{
  Scheme_Object *o = argv[0];
  Scheme_Type t;

  if (SCHEME_INTP(o)) {
#ifdef USE_SINGLE_FLOATS_AS_DEFAULT
    return scheme_make_float(SCHEME_INT_VAL(o));
#else
    return scheme_make_double(SCHEME_INT_VAL(o));
#endif
  }
  t = _SCHEME_TYPE(o);
#ifdef MZ_USE_SINGLE_FLOATS
  if (t == scheme_float_type)
    return o;
#endif
  if (t == scheme_double_type)
    return o;
  if (t == scheme_bignum_type) {
#ifdef USE_SINGLE_FLOATS_AS_DEFAULT
    return scheme_make_float(scheme_bignum_to_float(o));
#else
    return scheme_make_double(scheme_bignum_to_double(o));
#endif
  }
  if (t == scheme_rational_type) {
#ifdef USE_SINGLE_FLOATS_AS_DEFAULT
    return scheme_make_float(scheme_rational_to_float(o));
#else
    return scheme_make_double(scheme_rational_to_double(o));
#endif
  }
  if (t == scheme_complex_type) {
    Scheme_Object *realpart, *imaginarypart;

    realpart = _scheme_complex_real_part(o);
    imaginarypart = _scheme_complex_imaginary_part(o);

    realpart = scheme_exact_to_inexact(1, &realpart);
    imaginarypart = scheme_exact_to_inexact(1, &imaginarypart);

    return scheme_make_complex(realpart, imaginarypart);
  }

  NEED_NUMBER(exact->inexact);

  ESCAPED_BEFORE_HERE;
}

Here is the call graph for this function:

Here is the caller graph for this function:

int scheme_get_int_val ( Scheme_Object o,
long *  v 
)

Definition at line 594 of file number.c.

{
  if (SCHEME_INTP(o)) {
    *v = SCHEME_INT_VAL(o);
    return 1;
  } else if (SCHEME_BIGNUMP(o))
    return scheme_bignum_get_int_val(o, v);
  else
    return 0;
}

Here is the call graph for this function:

Definition at line 619 of file number.c.

{
  if (SCHEME_INTP(o)) {
    *v = SCHEME_INT_VAL(o);
    return 1;
  } else if (SCHEME_BIGNUMP(o))
    return scheme_bignum_get_long_long_val(o, v);
  else
    return 0;
}

Here is the call graph for this function:

int scheme_get_unsigned_int_val ( Scheme_Object o,
unsigned long *  v 
)

Definition at line 605 of file number.c.

{
  if (SCHEME_INTP(o)) {
    long i = SCHEME_INT_VAL(o);
    if (i < 0)
      return 0;
    *v = i;
    return 1;
  } else if (SCHEME_BIGNUMP(o))
    return scheme_bignum_get_unsigned_int_val(o, v);
  else
    return 0;
}

Here is the call graph for this function:

Definition at line 630 of file number.c.

{
  if (SCHEME_INTP(o)) {
    long i = SCHEME_INT_VAL(o);
    if (i < 0)
      return 0;
    *v = i;
    return 1;
  } else if (SCHEME_BIGNUMP(o))
    return scheme_bignum_get_unsigned_long_long_val(o, v);
  else
    return 0;
}

Here is the call graph for this function:

Scheme_Object* scheme_inexact_p ( int  argc,
Scheme_Object argv[] 
)

Definition at line 930 of file number.c.

{
  int v;
  v = scheme_is_inexact(argv[0]);
  if (v < 0) {
    scheme_wrong_type("inexact?", "number", 0, argc, argv);
    ESCAPED_BEFORE_HERE;
  }
  return (v ? scheme_true : scheme_false);
}

Here is the caller graph for this function:

Definition at line 2376 of file number.c.

{
  Scheme_Object *o = argv[0];
  Scheme_Type t;

  if (SCHEME_INTP(o))
    return o;
  t = _SCHEME_TYPE(o);
  if (t == scheme_double_type
#ifdef MZ_USE_SINGLE_FLOATS
      || t == scheme_float_type
#endif
      ) {
    double d = SCHEME_FLOAT_VAL(o);

    /* Try simple case: */
    Scheme_Object *i = scheme_make_integer((long)d);
    if ((double)SCHEME_INT_VAL(i) == d) {
# ifdef NAN_EQUALS_ANYTHING
      if (!MZ_IS_NAN(d))
#endif
       return i;
    }

    return scheme_rational_from_double(d);
  }
  if (t == scheme_bignum_type)
    return o;
  if (t == scheme_rational_type)
    return o;
  if (t == scheme_complex_type) {
    Scheme_Object *realpart, *imaginarypart;

    realpart = _scheme_complex_real_part(o);
    imaginarypart = _scheme_complex_imaginary_part(o);

    realpart = scheme_inexact_to_exact(1, &realpart);
    imaginarypart = scheme_inexact_to_exact(1, &imaginarypart);

    return scheme_make_complex(realpart, imaginarypart);
  }

  NEED_NUMBER(inexact->exact);

  ESCAPED_BEFORE_HERE;
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object* scheme_inf_plus_pi ( ) [static]

Definition at line 1623 of file number.c.

Definition at line 128 of file number.c.

{
  Scheme_Object *p;

  REGISTER_SO(scheme_pi);
  REGISTER_SO(scheme_half_pi);
  REGISTER_SO(scheme_zerod);
  REGISTER_SO(scheme_nzerod);
#ifdef MZ_USE_SINGLE_FLOATS
  REGISTER_SO(scheme_single_pi);
  REGISTER_SO(scheme_zerof);
  REGISTER_SO(scheme_nzerof);
#endif
  REGISTER_SO(scheme_plus_i);
  REGISTER_SO(scheme_minus_i);
  REGISTER_SO(scheme_inf_object);
  REGISTER_SO(scheme_minus_inf_object);
  REGISTER_SO(scheme_nan_object);
#ifdef MZ_USE_SINGLE_FLOATS
  REGISTER_SO(scheme_single_inf_object);
  REGISTER_SO(scheme_single_minus_inf_object);
  REGISTER_SO(scheme_single_nan_object);
#endif
    
  START_XFORM_SKIP;
#ifndef DONT_IGNORE_FPE_SIGNAL
  MZ_SIGSET(SIGFPE, SIG_IGN);
#endif
#ifdef FREEBSD_CONTROL_387
  __fpsetreg(FP_MSKS_FLD, FP_MSKS_REG, FP_MSKS_FLD, FP_MSKS_OFF);
#endif
#ifdef LINUX_CONTROL_387
  __setfpucw(_FPU_EXTENDED + _FPU_RC_NEAREST + 0x3F);
#endif
#ifdef IGNORE_BY_BORLAND_CONTROL_87
  {
    int bits = 0x3F + RC_NEAR + PC_64;
    _control87(bits, 0xFFFF);
  }
#endif
#ifdef IGNORE_BY_MS_CONTROL_87
  /* Shouldn't be necessary, because the C library
     should do this, but explictly masking exceptions
     makes MzScheme work under Bochs 2.1.1 with Win95 */
  _control87(_MCW_EM, _MCW_EM);
#endif
#ifdef ALPHA_CONTROL_FP
  {
    long flags = ieee_get_fp_control();
    flags |= IEEE_TRAP_ENABLE_MASK;
    ieee_set_fp_control(flags);
  }
#endif
#ifdef ASM_DBLPREC_CONTROL_87
  {
    /* Make x87 computations double-precision instead of 
       extended-precision, so that if/when the JIT generates
       x87 instructions, it's consistent with everything else. */
    int _dblprec = 0x27F;
    asm ("fldcw %0" : : "m" (_dblprec));
  }
#endif
  END_XFORM_SKIP;

#if defined(HUGE_VAL) && !defined(USE_DIVIDE_MAKE_INFINITY)
  scheme_infinity_val = HUGE_VAL;
#else
#ifndef USE_INFINITY_FUNC
  scheme_infinity_val = 1.0 / scheme_floating_point_zero;
#else
  scheme_infinity_val = infinity();
#endif
#endif

#ifdef ZERO_MINUS_ZERO_IS_POS_ZERO
  scheme_floating_point_nzero = -1.0 / scheme_infinity_val;
#else
  scheme_floating_point_nzero = - scheme_floating_point_nzero;
#endif

  scheme_minus_infinity_val = -scheme_infinity_val;
  not_a_number_val = scheme_infinity_val + scheme_minus_infinity_val;
  
  scheme_zerod = scheme_make_double(1.0);
  SCHEME_DBL_VAL(scheme_zerod) = 0.0;
  scheme_nzerod = scheme_make_double(-1.0);
  SCHEME_DBL_VAL(scheme_nzerod) = scheme_floating_point_nzero;
  
  scheme_pi = scheme_make_double(atan2(0.0, -1.0));
  scheme_half_pi = scheme_make_double(atan2(0.0, -1.0)/2);
#ifdef MZ_USE_SINGLE_FLOATS
  scheme_zerof = scheme_make_float(0.0f);
  scheme_nzerof = scheme_make_float(-0.0f);
  scheme_single_pi = scheme_make_float((float)atan2(0.0, -1.0));
#endif
  scheme_plus_i = scheme_make_complex(scheme_make_integer(0), scheme_make_integer(1));
  scheme_minus_i = scheme_make_complex(scheme_make_integer(0), scheme_make_integer(-1));
  
  scheme_inf_object = scheme_make_double(scheme_infinity_val);
  scheme_minus_inf_object = scheme_make_double(scheme_minus_infinity_val);
#ifdef NAN_EQUALS_ANYTHING
  scheme_nan_object = scheme_make_double(1);
  SCHEME_DBL_VAL(scheme_nan_object) = not_a_number_val;
#else
  scheme_nan_object = scheme_make_double(not_a_number_val);
#endif
#ifdef MZ_USE_SINGLE_FLOATS
  scheme_single_inf_object = scheme_make_float((float)scheme_infinity_val);
  scheme_single_minus_inf_object = scheme_make_float((float)scheme_minus_infinity_val);
  scheme_single_nan_object = scheme_make_float((float)not_a_number_val);
#endif

  p = scheme_make_folding_prim(number_p, "number?", 1, 1, 1);
  SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_UNARY_INLINED;
  scheme_add_global_constant("number?", p, env);

  scheme_add_global_constant("complex?", 
                          scheme_make_folding_prim(complex_p,
                                                "complex?",
                                                1, 1, 1),
                          env);

  p = scheme_make_folding_prim(real_p, "real?", 1, 1, 1);
  SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_UNARY_INLINED;
  scheme_add_global_constant("real?", p, env);

  scheme_add_global_constant("rational?", 
                          scheme_make_folding_prim(rational_p,
                                                "rational?",
                                                1, 1, 1),
                          env);
  scheme_add_global_constant("integer?", 
                          scheme_make_folding_prim(integer_p,
                                                "integer?",
                                                1, 1, 1),
                          env);

  p = scheme_make_folding_prim(exact_integer_p, "exact-integer?", 1, 1, 1);
  SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_UNARY_INLINED;
  scheme_add_global_constant("exact-integer?", p, env);

  p = scheme_make_folding_prim(exact_nonnegative_integer_p, "exact-nonnegative-integer?", 1, 1, 1);
  SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_UNARY_INLINED;
  scheme_add_global_constant("exact-nonnegative-integer?", p, env);

  p = scheme_make_folding_prim(exact_positive_integer_p, "exact-positive-integer?", 1, 1, 1);
  SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_UNARY_INLINED;
  scheme_add_global_constant("exact-positive-integer?", p, env);

  p = scheme_make_noncm_prim(fixnum_p, "fixnum?", 1, 1);
  SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_UNARY_INLINED;
  scheme_add_global_constant("fixnum?", p, env);

  p = scheme_make_folding_prim(inexact_real_p, "inexact-real?", 1, 1, 1);
  SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_UNARY_INLINED;
  scheme_add_global_constant("inexact-real?", p, env);

  scheme_add_global_constant("exact?", 
                          scheme_make_folding_prim(exact_p,
                                                "exact?",
                                                1, 1, 1),
                          env);
  scheme_add_global_constant("inexact?", 
                          scheme_make_folding_prim(scheme_inexact_p,
                                                "inexact?",
                                                1, 1, 1),
                          env);
  scheme_add_global_constant("odd?", 
                          scheme_make_folding_prim(scheme_odd_p,
                                                "odd?",
                                                1, 1, 1),
                          env);
  scheme_add_global_constant("even?", 
                          scheme_make_folding_prim(even_p,
                                                "even?",
                                                1, 1, 1),
                          env);

  p = scheme_make_folding_prim(scheme_bitwise_and, "bitwise-and", 0, -1, 1);
  SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_BINARY_INLINED;
  scheme_add_global_constant("bitwise-and", p, env);

  p = scheme_make_folding_prim(bitwise_or, "bitwise-ior", 0, -1, 1);
  SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_BINARY_INLINED;
  scheme_add_global_constant("bitwise-ior", p, env);

  p = scheme_make_folding_prim(bitwise_xor, "bitwise-xor", 0, -1, 1);
  SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_BINARY_INLINED;
  scheme_add_global_constant("bitwise-xor", p, env);

  p = scheme_make_folding_prim(bitwise_not, "bitwise-not", 1, 1, 1);
  SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_UNARY_INLINED;
  scheme_add_global_constant("bitwise-not", p, env);

  p = scheme_make_folding_prim(bitwise_bit_set_p, "bitwise-bit-set?", 2, 2, 1);
  SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_BINARY_INLINED;
  scheme_add_global_constant("bitwise-bit-set?", p, env);

  scheme_add_global_constant("bitwise-bit-field",
                             scheme_make_folding_prim(bitwise_bit_field, 
                                                      "bitwise-bit-field",
                                                      3, 3, 1), 
                             env);

  p = scheme_make_folding_prim(scheme_bitwise_shift, "arithmetic-shift", 2, 2, 1);
  SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_BINARY_INLINED;
  scheme_add_global_constant("arithmetic-shift", p, env);

  scheme_add_global_constant("integer-length",
                             scheme_make_folding_prim(integer_length, 
                                                      "integer-length", 
                                                      1, 1, 1), 
                             env);

  scheme_add_global_constant("gcd", 
                          scheme_make_folding_prim(gcd,
                                                "gcd", 
                                                0, -1, 1),
                          env);
  scheme_add_global_constant("lcm", 
                          scheme_make_folding_prim(lcm,
                                                "lcm", 
                                                0, -1, 1),
                          env);
  scheme_add_global_constant("floor", 
                          scheme_make_folding_prim(floor_prim,
                                                "floor",
                                                1, 1, 1),
                          env);
  scheme_add_global_constant("ceiling", 
                          scheme_make_folding_prim(ceiling,
                                                "ceiling",
                                                1, 1, 1),
                          env);
  scheme_add_global_constant("truncate", 
                          scheme_make_folding_prim(sch_truncate,
                                                "truncate",
                                                1, 1, 1),
                          env);
  scheme_add_global_constant("round", 
                          scheme_make_folding_prim(sch_round,
                                                "round",
                                                1, 1, 1),
                          env);
  scheme_add_global_constant("numerator", 
                          scheme_make_folding_prim(numerator,
                                                "numerator",
                                                1, 1, 1),
                          env);
  scheme_add_global_constant("denominator", 
                          scheme_make_folding_prim(denominator,
                                                "denominator",
                                                1, 1, 1),
                          env);
  scheme_add_global_constant("exp", 
                          scheme_make_folding_prim(exp_prim,
                                                "exp",
                                                1, 1, 1),
                          env);
  scheme_add_global_constant("log", 
                          scheme_make_folding_prim(log_prim,
                                                "log",
                                                1, 1, 1),
                          env);
  scheme_add_global_constant("sin", 
                          scheme_make_folding_prim(sin_prim,
                                                "sin",
                                                1, 1, 1),
                          env);
  scheme_add_global_constant("cos", 
                          scheme_make_folding_prim(cos_prim,
                                                "cos",
                                                1, 1, 1),
                          env);
  scheme_add_global_constant("tan", 
                          scheme_make_folding_prim(tan_prim,
                                                "tan",
                                                1, 1, 1),
                          env);
  scheme_add_global_constant("asin", 
                          scheme_make_folding_prim(asin_prim,
                                                "asin",
                                                1, 1, 1),
                          env);
  scheme_add_global_constant("acos", 
                          scheme_make_folding_prim(acos_prim,
                                                "acos",
                                                1, 1, 1),
                          env);
  scheme_add_global_constant("atan", 
                          scheme_make_folding_prim(atan_prim,
                                                "atan",
                                                1, 2, 1),
                          env);
  scheme_add_global_constant("sqrt", 
                          scheme_make_folding_prim(scheme_sqrt,
                                                "sqrt",
                                                1, 1, 1),
                          env);
  scheme_add_global_constant("integer-sqrt", 
                          scheme_make_folding_prim(int_sqrt,
                                                "integer-sqrt",
                                                1, 1, 1),
                          env);
  scheme_add_global_constant("integer-sqrt/remainder", 
                          scheme_make_prim_w_arity2(int_sqrt_rem,
                                                 "integer-sqrt/remainder",
                                                 1, 1,
                                                 2, 2),
                          env);
  scheme_add_global_constant("expt", 
                          scheme_make_folding_prim(scheme_expt,
                                                "expt", 
                                                2, 2, 1),
                          env);
  scheme_add_global_constant("make-rectangular", 
                          scheme_make_folding_prim(make_rectangular,
                                                "make-rectangular", 
                                                2, 2, 1),
                          env);
  scheme_add_global_constant("make-polar", 
                          scheme_make_folding_prim(scheme_make_polar,
                                                "make-polar", 
                                                2, 2, 1),
                          env);
  scheme_add_global_constant("real-part", 
                          scheme_make_folding_prim(real_part,
                                                "real-part",
                                                1, 1, 1),
                          env);
  scheme_add_global_constant("imag-part", 
                          scheme_make_folding_prim(imag_part,
                                                "imag-part",
                                                1, 1, 1),
                          env);
  scheme_add_global_constant("angle", 
                          scheme_make_folding_prim(angle,
                                                "angle",
                                                1, 1, 1),
                          env);
  scheme_add_global_constant("magnitude", 
                          scheme_make_folding_prim(magnitude,
                                                "magnitude",
                                                1, 1, 1),
                          env);
  scheme_add_global_constant("exact->inexact", 
                          scheme_make_folding_prim(scheme_exact_to_inexact,
                                                "exact->inexact",
                                                1, 1, 1),
                          env);
  scheme_add_global_constant("inexact->exact", 
                          scheme_make_folding_prim(scheme_inexact_to_exact,
                                                "inexact->exact",
                                                1, 1, 1),
                          env);
}

Here is the caller graph for this function:

Definition at line 2719 of file number.c.

{
  Scheme_Object *a[1], *r;
  a[0] = n;
  r = integer_length(1, a);
  return SCHEME_INT_VAL(r);
}

Here is the call graph for this function:

Definition at line 871 of file number.c.

{
  if (SCHEME_INTP(n)) {
    return 1;
  } else {
    Scheme_Type type = _SCHEME_TYPE(n);
    if ((type == scheme_bignum_type)
       || (type == scheme_rational_type))
      return 1;
    else if (type == scheme_complex_type) {
      return scheme_is_complex_exact(n);
    } else if (type == scheme_double_type)
      return 0;
#ifdef MZ_USE_SINGLE_FLOATS
    else if (type == scheme_float_type)
      return 0;
#endif
    else {
      return -1;
    }
  }
}

Here is the call graph for this function:

Definition at line 906 of file number.c.

{
  if (SCHEME_INTP(n)) {
    return 0;
  } else {
    Scheme_Type type = _SCHEME_TYPE(n);
    if ((type == scheme_bignum_type)
       || (type == scheme_rational_type))
      return 0;
    else if (type == scheme_complex_type) {
      return !scheme_is_complex_exact(n);
    } else if (type == scheme_double_type)
      return 1;
#ifdef MZ_USE_SINGLE_FLOATS
    else if (type == scheme_float_type)
      return 1;
#endif
    else {
      return -1;
    }
  }
}

Here is the call graph for this function:

Definition at line 787 of file number.c.

{
  if (SCHEME_INTP(o) || SCHEME_BIGNUMP(o))
    return 1;

  if (SCHEME_FLOATP(o)) {
    double d;
    d = SCHEME_FLOAT_VAL(o);
# ifdef NAN_EQUALS_ANYTHING
    if (MZ_IS_NAN(d))
      return 0;
# endif
    if (MZ_IS_INFINITY(d))
      return 0;
    if (floor(d) == d)
      return 1;
  }

  return 0;
}

Here is the caller graph for this function:

Definition at line 718 of file number.c.

{
  GC_CAN_IGNORE Scheme_Double *sd;

  if (d == 0.0) {
    if (minus_zero_p(d))
      return scheme_nzerod;
#ifdef NAN_EQUALS_ANYTHING
    else if (MZ_IS_NAN(d))
      return scheme_nan_object;
#endif
    else
      return scheme_zerod;
  }

  sd = (Scheme_Double *)scheme_malloc_small_atomic_tagged(sizeof(Scheme_Double));
  CLEAR_KEY_FIELD(&sd->so);
  sd->so.type = scheme_double_type;
  SCHEME_DBL_VAL(sd) = d;
  return (Scheme_Object *)sd;
}

Here is the call graph for this function:

Definition at line 487 of file number.c.

{
  Scheme_Object *o = scheme_make_integer(i);
  
  if (SCHEME_INT_VAL(o) == i)
    return o;
  else
    return scheme_make_bignum(i);
}
Scheme_Object* scheme_make_integer_value_from_long_halves ( unsigned long  lowhalf,
unsigned long  hihalf 
)

Definition at line 567 of file number.c.

{
#ifdef NO_LONG_LONG_TYPE
  /* hihalf and lowhalf form the two halves of a 64bit 
     number in 2's complement form.  This means that if the 
     topmost bit in hihalf is set, the number is actually 
     the negative version of the complement plus one.
  */
  
  return (hihalf < 0x80000000L
         ? scheme_make_integer_value_from_unsigned_long_long (lowhalf, hihalf)
         : scheme_bin_minus
         (scheme_make_integer (0),
          scheme_make_integer_value_from_unsigned_long_long
          ((lowhalf ^ 0xFFFFFFFFL) + 1,
           (hihalf  ^ 0xFFFFFFFFL) + (lowhalf == 0))));
#else
  mzlonglong v;

  v = (mzlonglong)lowhalf | ((mzlonglong)hihalf << 32);

  return scheme_make_integer_value_from_long_long(v);
#endif
}

Here is the call graph for this function:

Definition at line 509 of file number.c.

{
#if defined(SIXTY_FOUR_BIT_INTEGERS)
  return scheme_make_integer_value(i);
#else
  if (i < 0) {
    if (!(((i >> 32) & 0xFFFFFFFF) ^ 0xFFFFFFFF)
       && (i & 0x80000000)) {
      return scheme_make_integer_value((long)i);
    } else
      return scheme_make_bignum_from_long_long(i);
  } else {
    return scheme_make_integer_value_from_unsigned_long_long(i);
  }
#endif
}

Definition at line 498 of file number.c.

{
  Scheme_Object *o = scheme_make_integer(i);
  
  if ((SCHEME_INT_VAL(o) >= 0)
      && ((unsigned long)SCHEME_INT_VAL(o)) == i)
    return o;
  else
    return scheme_make_bignum_from_unsigned(i);
}
Scheme_Object* scheme_make_integer_value_from_unsigned_long_halves ( unsigned long  lowhalf,
unsigned long  hihalf 
)

Definition at line 541 of file number.c.

{
#ifdef NO_LONG_LONG_TYPE
  /*  Paste the two halves together by 
      hihalf * (2 ** 32) + lowhalf
      
      There may be a more efficient way to do this, but this way
      does not depend upon the representation of bignums.
  */
  
  return
    scheme_bin_plus
    (scheme_make_integer_value_from_unsigned (lowhalf),
     scheme_bin_mult (scheme_make_integer_value_from_unsigned (hihalf),
                    fixnum_expt (2, 32)));
#else
  umzlonglong v;

  v = ((umzlonglong)lowhalf) | ((umzlonglong)hihalf << 32);

  return scheme_make_integer_value_from_unsigned_long_long(v);
#endif
}

Here is the call graph for this function:

Definition at line 526 of file number.c.

{
#if defined(SIXTY_FOUR_BIT_INTEGERS)
  return scheme_make_integer_value_from_unsigned(i);
#else
  if (!((i >> 32) & 0xFFFFFFFF))
    return scheme_make_integer_value_from_unsigned((long)i);
  else
    return scheme_make_bignum_from_unsigned_long_long(i);
#endif
}
Scheme_Object* scheme_make_polar ( int  argc,
Scheme_Object argv[] 
)

Definition at line 2151 of file number.c.

{
  Scheme_Object *a, *b, *r, *i, *v;

  a = argv[0];
  b = argv[1];
  if (!SCHEME_REALP(a))
    scheme_wrong_type("make-polar", REAL_NUMBER_STR, 0, argc, argv);
  if (!SCHEME_REALP(b))
    scheme_wrong_type("make-polar", REAL_NUMBER_STR, 1, argc, argv);

  if (b == zeroi)
    return a;

  v = b;

  r = scheme_bin_mult(a, cos_prim(1, &v));
  i = scheme_bin_mult(a, sin_prim(1, &v));

  return scheme_make_complex(r, i);
}

Here is the call graph for this function:

Here is the caller graph for this function:

int scheme_minus_zero_p ( double  d)

Definition at line 673 of file number.c.

{
  return minus_zero_p(d);
}

Here is the call graph for this function:

Here is the caller graph for this function:

Definition at line 644 of file number.c.

{
  return ((SCHEME_INTP(n) && (SCHEME_INT_VAL(n) >= 0))
         || (SCHEME_BIGNUMP(n) && SCHEME_BIGPOS(n)));
}

Here is the caller graph for this function:

Scheme_Object* scheme_odd_p ( int  argc,
Scheme_Object argv[] 
)

Definition at line 943 of file number.c.

{
  Scheme_Object *v = argv[0];

  if (SCHEME_INTP(v))
    return (SCHEME_INT_VAL(v) & 0x1) ? scheme_true : scheme_false;
  if (SCHEME_BIGNUMP(v))
    return (SCHEME_BIGDIG(v)[0] & 0x1) ? scheme_true : scheme_false;
  
  if (scheme_is_integer(v)) {
    double d = SCHEME_FLOAT_VAL(v);
    if (MZ_IS_INFINITY(d))
      return scheme_true;
    return (fmod(d, 2.0) == 0.0) ? scheme_false : scheme_true;
  }

  NEED_INTEGER(odd?);

  ESCAPED_BEFORE_HERE;
}

Here is the call graph for this function:

Here is the caller graph for this function:

Definition at line 650 of file number.c.

{
  if (SCHEME_INTP(r))
    return (double)SCHEME_INT_VAL(r);
  else if (SCHEME_DBLP(r))
    return SCHEME_DBL_VAL(r);
#ifdef MZ_USE_SINGLE_FLOATS
  else if (SCHEME_FLTP(r))
    return SCHEME_FLT_VAL(r);
#endif
  else if (SCHEME_BIGNUMP(r))
    return scheme_bignum_to_double(r);
  else if (SCHEME_RATIONALP(r))
    return scheme_rational_to_double(r);
  else
    return 0.0;
}

Here is the call graph for this function:

Scheme_Object* scheme_sqrt ( int  argc,
Scheme_Object argv[] 
)

Definition at line 1782 of file number.c.

{
  int imaginary = 0;
  Scheme_Object *n;
  
  n = argv[0];

  if (SCHEME_COMPLEXP(n))
    return scheme_complex_sqrt(n);

  if (!SCHEME_REALP(n))
    scheme_wrong_type("sqrt", "number", 0, argc, argv);

  if (scheme_is_negative(n)) {
    n = scheme_bin_minus(zeroi, n);
    imaginary = 1;
  }

  if (SCHEME_INTP(n) || SCHEME_BIGNUMP(n))
    n = scheme_integer_sqrt(n);
#ifdef MZ_USE_SINGLE_FLOATS
  else if (SCHEME_FLTP(n))
    n = scheme_make_float((float)sqrt(SCHEME_FLT_VAL(n)));
#endif
  else if (SCHEME_DBLP(n)) {
    double d = SCHEME_DBL_VAL(n);
#ifdef SQRT_NAN_IS_WRONG
    if (MZ_IS_NAN(d))
      return scheme_nan_object;
#endif
    n = scheme_make_double(sqrt(d));
  } else if (SCHEME_RATIONALP(n))
    n = scheme_rational_sqrt(n);

  if (imaginary)
    return scheme_make_complex(zeroi, n);
  else
    return n;
}

Here is the call graph for this function:

Here is the caller graph for this function:

Definition at line 1364 of file number.c.

{
  if (SCHEME_INTP(o))
    return scheme_make_bignum(SCHEME_INT_VAL(o));
  else
    return (Scheme_Object *)o;
}

Here is the caller graph for this function:

Definition at line 1350 of file number.c.

{
  return scheme_exact_to_inexact(1, (Scheme_Object **)&n);
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object* sin_prim ( int  argc,
Scheme_Object argv[] 
) [static]

Here is the caller graph for this function:

static Scheme_Object* slow_bitwise_bit_field ( int  argc,
Scheme_Object argv[],
Scheme_Object so,
Scheme_Object sb1,
Scheme_Object sb2 
) [static]

Definition at line 2574 of file number.c.

{
  Scheme_Object *a[2];

  if (!SCHEME_EXACT_INTEGERP(so))
    scheme_wrong_type("bitwise-bit-field", "exact integer", 0, argc, argv);

  if (!((SCHEME_INTP(sb1) && (SCHEME_INT_VAL(sb1) >= 0))
        || (SCHEME_BIGNUMP(sb1) && SCHEME_BIGPOS(sb1))))
    scheme_wrong_type("bitwise-bit-field", "nonnegative exact integer", 1, argc, argv);
  if (!((SCHEME_INTP(sb2) && (SCHEME_INT_VAL(sb2) >= 0))
        || (SCHEME_BIGNUMP(sb2) && SCHEME_BIGPOS(sb2))))
    scheme_wrong_type("bitwise-bit-field", "nonnegative exact integer", 2, argc, argv);

  if (!scheme_bin_lt_eq(sb1, sb2))
    scheme_raise_exn(MZEXN_FAIL_CONTRACT,
                     "bitwise-bit-field: first index: %V is more than second index: %V",
                     sb1, sb2);
  
  sb2 = scheme_bin_minus(sb2, sb1);
  sb1 = scheme_bin_minus(scheme_make_integer(0), sb1);
  
  a[0] = so;
  a[1] = sb1;
  so = scheme_bitwise_shift(2, a);
  
  a[0] = scheme_make_integer(1);
  a[1] = sb2;
  sb2 = scheme_bitwise_shift(2, a);
  
  sb2 = scheme_bin_minus(sb2, scheme_make_integer(1));
  
  a[0] = so;
  a[1] = sb2;
  return scheme_bitwise_and(2, a);    
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object* tan_prim ( int  argc,
Scheme_Object argv[] 
) [static]

Here is the caller graph for this function:

Definition at line 1355 of file number.c.

Here is the call graph for this function:

static Scheme_Object * un_exp ( Scheme_Object o) [static]

Definition at line 1421 of file number.c.

{
  return exp_prim(1, &o);
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object * un_log ( Scheme_Object o) [static]

Definition at line 1426 of file number.c.

{
  return log_prim(1, &o);
}

Here is the call graph for this function:

Here is the caller graph for this function:


Variable Documentation

double not_a_number_val [static]

Definition at line 101 of file number.c.

Definition at line 114 of file number.c.

Definition at line 113 of file number.c.

Definition at line 107 of file number.c.

Definition at line 103 of file number.c.

Definition at line 56 of file number.c.

Definition at line 107 of file number.c.

Definition at line 103 of file number.c.

Definition at line 56 of file number.c.

Definition at line 103 of file number.c.

Definition at line 107 of file number.c.

Definition at line 107 of file number.c.

Definition at line 107 of file number.c.

Definition at line 107 of file number.c.