Back to index

plt-scheme  4.2.1
Defines | Functions
numarith.c File Reference
#include "schpriv.h"
#include "nummacs.h"
#include <math.h>

Go to the source code of this file.

Defines

#define zeroi   scheme_exact_zero
#define F_ADD(x, y)   scheme_make_double(x + y)
#define F_SUBTRACT(x, y)   scheme_make_double(x - y)
#define F_MULTIPLY(x, y)   scheme_make_double(x * y)
#define DIVIDE(x, y)   scheme_make_fixnum_rational(x, y)
#define F_DIVIDE(x, y)   scheme_make_double((double)x / (double)y)
#define FS_ADD(x, y)   scheme_make_float(x + y)
#define FS_SUBTRACT(x, y)   scheme_make_float(x - y)
#define FS_MULTIPLY(x, y)   scheme_make_float(x * y)
#define FS_DIVIDE(x, y)   scheme_make_float((float)x / (float)y)
#define ret_other(n1, n2)   if (SAME_OBJ(n1, scheme_make_integer(0))) return (Scheme_Object *)n2
#define ret_1other(n1, n2)   if (SAME_OBJ(n1, scheme_make_integer(1))) return (Scheme_Object *)n2
#define ret_zero(n1, n2)   if (SAME_OBJ(n1, scheme_make_integer(0))) return scheme_make_integer(0)
#define ABS(n)   ((n>0) ? n : -n)

Functions

static Scheme_Objectplus (int argc, Scheme_Object *argv[])
static Scheme_Objectminus (int argc, Scheme_Object *argv[])
static Scheme_Objectmult (int argc, Scheme_Object *argv[])
static Scheme_Objectdiv_prim (int argc, Scheme_Object *argv[])
static Scheme_Objectquotient (int argc, Scheme_Object *argv[])
static Scheme_Objectrem_prim (int argc, Scheme_Object *argv[])
static Scheme_Objectquotient_remainder (int argc, Scheme_Object *argv[])
void scheme_init_numarith (Scheme_Env *env)
Scheme_Objectscheme_add1 (int argc, Scheme_Object *argv[])
Scheme_Objectscheme_sub1 (int argc, Scheme_Object *argv[])
static Scheme_ObjectADD_slow (long a, long b)
static Scheme_ObjectADD (long a, long b)
static Scheme_ObjectSUBTRACT_slow (long a, long b)
static Scheme_ObjectSUBTRACT (long a, long b)
static Scheme_ObjectMULTIPLY (long a, long b)
static Scheme_Objectunary_minus (const Scheme_Object *n)
static MZ_INLINE Scheme_Objectminus_slow (Scheme_Object *ret, int argc, Scheme_Object *argv[])
Scheme_Objectscheme_abs (int argc, Scheme_Object *argv[])
Scheme_Objectdo_bin_quotient (const char *name, const Scheme_Object *n1, const Scheme_Object *n2, Scheme_Object **bn_rem)
Scheme_Objectscheme_bin_quotient (const Scheme_Object *n1, const Scheme_Object *n2)
static Scheme_Objectrem_mod (int argc, Scheme_Object *argv[], char *name, int first_sign)
Scheme_Objectscheme_modulo (int argc, Scheme_Object *argv[])

Define Documentation

#define ABS (   n)    ((n>0) ? n : -n)

Definition at line 349 of file numarith.c.

#define DIVIDE (   x,
  y 
)    scheme_make_fixnum_rational(x, y)

Definition at line 169 of file numarith.c.

#define F_ADD (   x,
  y 
)    scheme_make_double(x + y)

Definition at line 166 of file numarith.c.

#define F_DIVIDE (   x,
  y 
)    scheme_make_double((double)x / (double)y)

Definition at line 170 of file numarith.c.

#define F_MULTIPLY (   x,
  y 
)    scheme_make_double(x * y)

Definition at line 168 of file numarith.c.

#define F_SUBTRACT (   x,
  y 
)    scheme_make_double(x - y)

Definition at line 167 of file numarith.c.

#define FS_ADD (   x,
  y 
)    scheme_make_float(x + y)

Definition at line 172 of file numarith.c.

#define FS_DIVIDE (   x,
  y 
)    scheme_make_float((float)x / (float)y)

Definition at line 175 of file numarith.c.

#define FS_MULTIPLY (   x,
  y 
)    scheme_make_float(x * y)

Definition at line 174 of file numarith.c.

#define FS_SUBTRACT (   x,
  y 
)    scheme_make_float(x - y)

Definition at line 173 of file numarith.c.

#define ret_1other (   n1,
  n2 
)    if (SAME_OBJ(n1, scheme_make_integer(1))) return (Scheme_Object *)n2

Definition at line 253 of file numarith.c.

#define ret_other (   n1,
  n2 
)    if (SAME_OBJ(n1, scheme_make_integer(0))) return (Scheme_Object *)n2

Definition at line 252 of file numarith.c.

#define ret_zero (   n1,
  n2 
)    if (SAME_OBJ(n1, scheme_make_integer(0))) return scheme_make_integer(0)

Definition at line 254 of file numarith.c.

#define zeroi   scheme_exact_zero

Definition at line 38 of file numarith.c.


Function Documentation

static Scheme_Object* ADD ( long  a,
long  b 
) [static]

Definition at line 184 of file numarith.c.

{
  long r;
  Scheme_Object *o;

  r = a + b;

  o = scheme_make_integer(r);
  r = SCHEME_INT_VAL(o);

  if (b == r - a)
    return o;
  else
    return ADD_slow(a, b);
}

Here is the call graph for this function:

static Scheme_Object* ADD_slow ( long  a,
long  b 
) [static]

Definition at line 177 of file numarith.c.

Here is the call graph for this function:

Here is the caller graph for this function:

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

Definition at line 311 of file numarith.c.

{
  Scheme_Object *ret;
  int i;

  ret = argv[0];
  if (!SCHEME_NUMBERP(ret)) {
    scheme_wrong_type("/", "number", 0, argc, argv);
    ESCAPED_BEFORE_HERE;
  }
  if (argc == 1) {
    if (ret != zeroi)
      return scheme_bin_div(scheme_make_integer(1), ret);
    else {
      scheme_raise_exn(MZEXN_FAIL_CONTRACT_DIVIDE_BY_ZERO,
                     "/: division by zero");
      ESCAPED_BEFORE_HERE;
    }
  }
  for (i = 1; i < argc; i++) {
    Scheme_Object *o = argv[i];

    if (!SCHEME_NUMBERP(o)) {
      scheme_wrong_type("/", "number", i, argc, argv);
      ESCAPED_BEFORE_HERE;
    }

    if (o != zeroi)
      ret = scheme_bin_div(ret, o);
    else {
      scheme_raise_exn(MZEXN_FAIL_CONTRACT_DIVIDE_BY_ZERO,
                     "/: division by zero");
      ESCAPED_BEFORE_HERE;
    }
  }
  return ret;
}

Here is the call graph for this function:

Here is the caller graph for this function:

Scheme_Object* do_bin_quotient ( const char *  name,
const Scheme_Object n1,
const Scheme_Object n2,
Scheme_Object **  bn_rem 
)

Definition at line 388 of file numarith.c.

{
  Scheme_Object *q;

  if (!scheme_is_integer(n1)) {
    Scheme_Object *a[2];
    a[0] = (Scheme_Object *)n1;
    a[1] = (Scheme_Object *)n2;
    scheme_wrong_type(name, "integer", 0, 2, a);
  }
  if (!scheme_is_integer(n2)) {
    Scheme_Object *a[2];
    a[0] = (Scheme_Object *)n1;
    a[1] = (Scheme_Object *)n2;
    scheme_wrong_type(name, "integer", 1, 2, a);
  }

  if (SCHEME_INTP(n2) && !SCHEME_INT_VAL(n2))
    scheme_raise_exn(MZEXN_FAIL_CONTRACT_DIVIDE_BY_ZERO,
                   "%s: undefined for 0", name);
  if (
#ifdef MZ_USE_SINGLE_FLOATS
      (SCHEME_FLTP(n2) && (SCHEME_FLT_VAL(n2) == 0.0f)) ||
#endif
      (SCHEME_DBLP(n2) && (SCHEME_DBL_VAL(n2) == 0.0)))
    scheme_raise_exn(MZEXN_FAIL_CONTRACT_DIVIDE_BY_ZERO,
                   "%s: undefined for 0.0", name);

  if (SCHEME_INTP(n1) && SCHEME_INTP(n2)) {
    return (scheme_make_integer (SCHEME_INT_VAL(n1) / SCHEME_INT_VAL(n2)));
  }
  if (SCHEME_DBLP(n1) || SCHEME_DBLP(n2)) {
    Scheme_Object *r;
    double d, d2;

    r = scheme_bin_div(n1, n2); /* could be exact 0 ... */
    if (SCHEME_DBLP(r)) {
      d = SCHEME_DBL_VAL(r);
      
      if (d > 0)
       d2 = floor(d);
      else
       d2 = ceil(d);
      
      if (d2 == d)
       return r;
      else
       return scheme_make_double(d2);
    } else
      return r;
  }
#ifdef MZ_USE_SINGLE_FLOATS
  if (SCHEME_FLTP(n1) || SCHEME_FLTP(n2)) {
    Scheme_Object *r;
    float d, d2;

    r = scheme_bin_div(n1, n2); /* could be exact 0 ... */
    if (SCHEME_FLTP(r)) {
      d = SCHEME_FLT_VAL(r);
      
      if (d > 0)
       d2 = floor(d);
      else
       d2 = ceil(d);
      
      if (d2 == d)
       return r;
      else
       return scheme_make_float(d2);
    } else
      return r;
  }
#endif

#if 0
  /* I'm pretty sure this isn't needed, but I'm keeping the code just
     in case... 03/19/2000 */
  if (SCHEME_RATIONALP(n1))
    WRONG_TYPE(name, "integer", n1);
  if (SCHEME_RATIONALP(n2))
    WRONG_TYPE(name, "integer", n2);
#endif
  
  n1 = scheme_to_bignum(n1);
  n2 = scheme_to_bignum(n2);

  scheme_bignum_divide(n1, n2, &q, bn_rem, 1);
  return q;
}

Here is the call graph for this function:

Here is the caller graph for this function:

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

Definition at line 280 of file numarith.c.

{
  Scheme_Object *ret, *v;

  ret = argv[0];
  if (!SCHEME_NUMBERP(ret)) {
    scheme_wrong_type("-", "number", 0, argc, argv);
    ESCAPED_BEFORE_HERE;
  }
  if (argc == 1) {
    if (SCHEME_FLOATP(ret)) {
#ifdef MZ_USE_SINGLE_FLOATS
      if (SCHEME_FLTP(ret))
       return scheme_make_float(-SCHEME_FLT_VAL(ret));
#endif
      return scheme_make_double(-SCHEME_DBL_VAL(ret));
    }
    return scheme_bin_minus(zeroi, ret);
  }
  if (argc == 2) {
    v = argv[1];
    if (!SCHEME_NUMBERP(v)) {
      scheme_wrong_type("-", "number", 1, argc, argv);
      ESCAPED_BEFORE_HERE;
    } 
    return scheme_bin_minus(ret, v);
  }
  return minus_slow(ret, argc, argv);
}

Here is the call graph for this function:

Here is the caller graph for this function:

static MZ_INLINE Scheme_Object* minus_slow ( Scheme_Object ret,
int  argc,
Scheme_Object argv[] 
) [static]

Definition at line 265 of file numarith.c.

{
  int i;
  for (i = 1; i < argc; i++) {
    Scheme_Object *o = argv[i];
    if (!SCHEME_NUMBERP(o)) {
      scheme_wrong_type("-", "number", i, argc, argv);
      ESCAPED_BEFORE_HERE;
    }
    ret = scheme_bin_minus(ret, o);
  }
  return ret;
}

Here is the call graph for this function:

Here is the caller graph for this function:

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

Here is the caller graph for this function:

static Scheme_Object* MULTIPLY ( long  a,
long  b 
) [static]

Definition at line 223 of file numarith.c.

{
  long r;
  Scheme_Object *o;

  if (!b)
    return zeroi;

  r = a * b;

  o = scheme_make_integer(r);
  r = SCHEME_INT_VAL(o);

  if (a == r / b)
    return o;
  else {
    Small_Bignum sa, sb;
    return scheme_bignum_multiply(scheme_make_small_bignum(a, &sa),
                              scheme_make_small_bignum(b, &sb));
  }
}

Here is the call graph for this function:

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

Here is the caller graph for this function:

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

Definition at line 485 of file numarith.c.

{
  return do_bin_quotient("quotient", argv[0], argv[1], NULL);
}

Here is the call graph for this function:

Here is the caller graph for this function:

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

Definition at line 698 of file numarith.c.

{
  Scheme_Object *rem = NULL, *quot, *a[2];

  quot = do_bin_quotient("quotient/remainder", argv[0], argv[1], &rem);
  if (!rem) {
    rem = rem_mod(argc, argv, "remainder", 1);
  }
  a[0] = quot;
  a[1] = rem;
  return scheme_values(2, a);
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object * rem_mod ( int  argc,
Scheme_Object argv[],
char *  name,
int  first_sign 
) [static]

Definition at line 495 of file numarith.c.

{
  Scheme_Object *n1, *n2, *r;
  int negate;

  n1 = argv[0];
  n2 = argv[1];

  if (!scheme_is_integer(n1))
    scheme_wrong_type(name, "integer", 0, argc, argv);
  if (!scheme_is_integer(n2))
    scheme_wrong_type(name, "integer", 1, argc, argv);

  if (SCHEME_INTP(n2) && !SCHEME_INT_VAL(n2))
    scheme_raise_exn(MZEXN_FAIL_CONTRACT_DIVIDE_BY_ZERO,
                   "%s: undefined for 0", name);
  if (
#ifdef MZ_USE_SINGLE_FLOATS
      (SCHEME_FLTP(n2) && (SCHEME_FLT_VAL(n2) == 0.0f)) ||
#endif
      (SCHEME_DBLP(n2) && (SCHEME_DBL_VAL(n2) == 0.0))) {
    int neg;
    neg = scheme_minus_zero_p(SCHEME_FLOAT_VAL(n2));
    scheme_raise_exn(MZEXN_FAIL_CONTRACT_DIVIDE_BY_ZERO,
                   "%s: undefined for %s0.0",
                   name,
                   neg ? "-" : "");
  }

  if (SCHEME_INTP(n1) && !SCHEME_INT_VAL(n1))
    return zeroi;

  if (SCHEME_INTP(n1) && SCHEME_INTP(n2)) {
    long a, b, na, nb, v;
    int neg1, neg2;

    a = SCHEME_INT_VAL(n1);
    b = SCHEME_INT_VAL(n2);
    na =  (a < 0) ? -a : a;
    nb =  (b < 0) ? -b : b;

    v = na % nb;

    if (v) {
      if (first_sign) {
       if (a < 0)
         v = -v;
      } else {
       neg1 = (a < 0);
       neg2 = (b < 0);
       
       if (neg1 != neg2)
         v = nb - v;
       
       if (neg2)
         v = -v;
      }
    }

    return scheme_make_integer(v);
  }

  if (SCHEME_FLOATP(n1) || SCHEME_FLOATP(n2)) {
    double a, b, na, nb, v;
#ifdef MZ_USE_SINGLE_FLOATS
    int was_single = !(SCHEME_DBLP(n1) || SCHEME_DBLP(n2));
#endif

    if (SCHEME_INTP(n1))
      a = SCHEME_INT_VAL(n1);
#ifdef MZ_USE_SINGLE_FLOATS
    else if (SCHEME_FLTP(n1))
      a = SCHEME_FLT_VAL(n1);
#endif
    else if (SCHEME_DBLP(n1))
      a = SCHEME_DBL_VAL(n1);
    else
      a = scheme_bignum_to_double(n1);

    if (SCHEME_INTP(n2))
      b = SCHEME_INT_VAL(n2);
#ifdef MZ_USE_SINGLE_FLOATS
    else if (SCHEME_FLTP(n2))
      b = SCHEME_FLT_VAL(n2);
#endif
    else if (SCHEME_DBLP(n2))
      b = SCHEME_DBL_VAL(n2);
    else
      b = scheme_bignum_to_double(n2);

    if (a == 0.0) {
      /* Avoid sign problems. */
#ifdef MZ_USE_SINGLE_FLOATS
      if (was_single)
       return scheme_zerof;
#endif
      return scheme_zerod;
    }

    na =  (a < 0) ? -a : a;
    nb =  (b < 0) ? -b : b;

    if (MZ_IS_POS_INFINITY(nb))
      v = na;
    else if (MZ_IS_POS_INFINITY(na)) {
#ifdef MZ_USE_SINGLE_FLOATS
      if (was_single)
       return scheme_zerof;
#endif
      return scheme_zerod;
    } else {
      v = fmod(na, nb);

#ifdef FMOD_CAN_RETURN_NEG_ZERO
      if (v == 0.0)
       v = 0.0;
#endif
    }

    if (v) {
      if (first_sign) {
       if (a < 0)
         v = -v;
      } else {
       int neg1, neg2;
       
       neg1 = (a < 0);
       neg2 = (b < 0);
       
       if (neg1 != neg2)
         v = nb - v;
       
       if (neg2)
         v = -v;
      }
    }

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

    return scheme_make_double(v);
  }

  n1 = scheme_to_bignum(n1);
  n2 = scheme_to_bignum(n2);

  scheme_bignum_divide(n1, n2, NULL, &r, 1);

  negate = 0;

  if (!SCHEME_INTP(r) || SCHEME_INT_VAL(r)) {
    /* Easier if we can assume 'r' is positive: */
    if (SCHEME_INTP(r)) {
      if (SCHEME_INT_VAL(r) < 0)
       r = scheme_make_integer(-SCHEME_INT_VAL(r));
    } else if (!SCHEME_BIGPOS(r))
      r = scheme_bignum_negate(r);

    if (first_sign) {
      if (!SCHEME_BIGPOS(n1))
       negate = 1;
    } else {
      int neg1, neg2;
      
      neg1 = !SCHEME_BIGPOS(n1);
      neg2 = !SCHEME_BIGPOS(n2);
      
      if (neg1 != neg2) {
       if (neg2)
         r = scheme_bin_plus(n2, r);
       else
         r = scheme_bin_minus(n2, r);
      } else if (neg2)
       negate = 1;
    }
    
    if (negate) {
      if (SCHEME_INTP(r))
       r = scheme_make_integer(-SCHEME_INT_VAL(r));
      else
       r = scheme_bignum_negate(r);
    }
  }

  return r;
}

Here is the call graph for this function:

Here is the caller graph for this function:

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

Definition at line 685 of file numarith.c.

{
  return rem_mod(argc, argv, "remainder", 1);
}

Here is the call graph for this function:

Here is the caller graph for this function:

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

Definition at line 352 of file numarith.c.

{
  Scheme_Type t;
  Scheme_Object *o;

  o = argv[0];

  if (SCHEME_INTP(o)) {
    long n = SCHEME_INT_VAL(o);
    return scheme_make_integer_value(ABS(n));
  } 
  t = _SCHEME_TYPE(o);
#ifdef MZ_USE_SINGLE_FLOATS
  if (t == scheme_float_type)
    return scheme_make_float(fabs(SCHEME_FLT_VAL(o)));
#endif
  if (t == scheme_double_type)
    return scheme_make_double(fabs(SCHEME_DBL_VAL(o)));
  if (t == scheme_bignum_type) {
    if (SCHEME_BIGPOS(o))
      return o;
    return scheme_bignum_negate(o);
  }
  if (t == scheme_rational_type) {
    if (scheme_is_rational_positive(o))
      return o;
    else
      return scheme_rational_negate(o);
  }

  NEED_REAL(abs);

  ESCAPED_BEFORE_HERE;
}

Here is the call graph for this function:

Here is the caller graph for this function:

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

Definition at line 97 of file numarith.c.

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

  if (SCHEME_INTP(o)) {
    long v;
    v = SCHEME_INT_VAL(o);
    if (v < 0x3FFFFFFF)
      return scheme_make_integer(v + 1);
    else {
      Small_Bignum b;
      return scheme_bignum_add1(scheme_make_small_bignum(v, &b));
    }
  }
  t = _SCHEME_TYPE(o);
#ifdef MZ_USE_SINGLE_FLOATS
  if (t == scheme_float_type)
    return scheme_make_float(SCHEME_FLT_VAL(o) + 1.0f);
#endif
  if (t == scheme_double_type)
    return scheme_make_double(SCHEME_DBL_VAL(o) + 1.0);
  if (t == scheme_bignum_type)
    return scheme_bignum_add1(o);
  if (t == scheme_rational_type)
    return scheme_rational_add1(o);
  if (t == scheme_complex_type)
    return scheme_complex_add1(o);

  NEED_NUMBER(add1);

  ESCAPED_BEFORE_HERE;
}

Here is the call graph for this function:

Here is the caller graph for this function:

Definition at line 479 of file numarith.c.

{
  return do_bin_quotient("quotient", n1, n2, NULL);
}

Here is the call graph for this function:

Here is the caller graph for this function:

Definition at line 40 of file numarith.c.

{
  Scheme_Object *p;

  p = scheme_make_folding_prim(scheme_add1, "add1", 1, 1, 1);
  SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_UNARY_INLINED;
  scheme_add_global_constant("add1", p, env);

  p = scheme_make_folding_prim(scheme_sub1, "sub1", 1, 1, 1);
  SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_UNARY_INLINED;
  scheme_add_global_constant("sub1", p, env);

  p = scheme_make_folding_prim(plus, "+", 0, -1, 1);
  SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_BINARY_INLINED;
  scheme_add_global_constant("+", p, env);

  p = scheme_make_folding_prim(minus, "-", 1, -1, 1);
  SCHEME_PRIM_PROC_FLAGS(p) |= (SCHEME_PRIM_IS_BINARY_INLINED
                                | SCHEME_PRIM_IS_UNARY_INLINED);
  scheme_add_global_constant("-", p, env);

  p = scheme_make_folding_prim(mult, "*", 0, -1, 1);
  SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_BINARY_INLINED;
  scheme_add_global_constant("*", p, env);

  p = scheme_make_folding_prim(div_prim, "/", 1, -1, 1);
  SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_BINARY_INLINED;
  scheme_add_global_constant("/", p, env);

  p = scheme_make_folding_prim(scheme_abs, "abs", 1, 1, 1);
  SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_UNARY_INLINED;
  scheme_add_global_constant("abs", p, env);

  scheme_add_global_constant("quotient", 
                          scheme_make_folding_prim(quotient,
                                                "quotient", 
                                                2, 2, 1),
                          env);
  scheme_add_global_constant("remainder", 
                          scheme_make_folding_prim(rem_prim,
                                                "remainder", 
                                                2, 2, 1),
                          env);
  scheme_add_global_constant("quotient/remainder", 
                          scheme_make_prim_w_arity2(quotient_remainder,
                                                 "quotient/remainder", 
                                                 2, 2,
                                                 2, 2),
                          env);
  scheme_add_global_constant("modulo", 
                          scheme_make_folding_prim(scheme_modulo,
                                                "modulo", 
                                                2, 2, 1),
                          env);
}

Here is the call graph for this function:

Here is the caller graph for this function:

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

Definition at line 691 of file numarith.c.

{
  return rem_mod(argc, argv, "modulo", 0);
}

Here is the call graph for this function:

Here is the caller graph for this function:

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

Definition at line 132 of file numarith.c.

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

  if (SCHEME_INTP(o)) {
    long v;
    v = SCHEME_INT_VAL(o);
    if (v > -(0x3FFFFFFF))
      return scheme_make_integer(SCHEME_INT_VAL(o) - 1);
    else {
      Small_Bignum b;
      return scheme_bignum_sub1(scheme_make_small_bignum(v, &b));
    }
  }
  t = _SCHEME_TYPE(o);
#ifdef MZ_USE_SINGLE_FLOATS
  if (t == scheme_float_type)
    return scheme_make_float(SCHEME_FLT_VAL(o) - 1.0f);
#endif
  if (t == scheme_double_type)
    return scheme_make_double(SCHEME_DBL_VAL(o) - 1.0);
  if (t == scheme_bignum_type)
    return scheme_bignum_sub1(o);
  if (t == scheme_rational_type)
    return scheme_rational_sub1(o);
  if (t == scheme_complex_type)
    return scheme_complex_sub1(o);
  
  NEED_NUMBER(sub1);

  ESCAPED_BEFORE_HERE;
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object* SUBTRACT ( long  a,
long  b 
) [static]

Definition at line 207 of file numarith.c.

{
  long r;
  Scheme_Object *o;

  r = a - b;

  o = scheme_make_integer(r);
  r = SCHEME_INT_VAL(o);

  if (a == r + b)
    return o;
  else
    return SUBTRACT_slow(a, b);
}

Here is the call graph for this function:

static Scheme_Object* SUBTRACT_slow ( long  a,
long  b 
) [static]

Definition at line 200 of file numarith.c.

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object* unary_minus ( const Scheme_Object n) [static]

Definition at line 245 of file numarith.c.

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

Here is the call graph for this function: