*** empty log message ***

[bpt/guile.git] / libguile / numbers.c

diff --git a/libguile/numbers.c b/libguile/numbers.c
index d73cadc..362a565 100644 (file)
--- a/libguile/numbers.c
+++ b/libguile/numbers.c
@@ -47,28 +47,48 @@
 #include <stdio.h>
 #include <math.h>
 #include "libguile/_scm.h"
 #include <stdio.h>
 #include <math.h>
 #include "libguile/_scm.h"

-#include "libguile/unif.h"

 #include "libguile/feature.h"
 #include "libguile/ports.h"
 #include "libguile/root.h"
 #include "libguile/smob.h"
 #include "libguile/strings.h"
 #include "libguile/feature.h"
 #include "libguile/ports.h"
 #include "libguile/root.h"
 #include "libguile/smob.h"
 #include "libguile/strings.h"

-#include "libguile/vectors.h"

 
 #include "libguile/validate.h"
 #include "libguile/numbers.h"
 
 #include "libguile/validate.h"
 #include "libguile/numbers.h"

+

 \f
 \f

+
+static SCM scm_divbigbig (SCM_BIGDIG *x, scm_sizet nx, SCM_BIGDIG *y, scm_sizet ny, int sgn, int modes);
+static SCM scm_divbigint (SCM x, long z, int sgn, int mode);
+
+

 #define DIGITS '0':case '1':case '2':case '3':case '4':\
  case '5':case '6':case '7':case '8':case '9'
 
 
 #define DIGITS '0':case '1':case '2':case '3':case '4':\
  case '5':case '6':case '7':case '8':case '9'
 
 

+#define SCM_SWAP(x,y) do { SCM __t = x; x = y; y = __t; } while (0)
+
+
+#if (SCM_DEBUG_DEPRECATED == 1)  /* not defined in header yet? */
+
+/* SCM_FLOBUFLEN is the maximum number of characters neccessary for the
+ * printed or scm_string representation of an inexact number.
+ */
+#define SCM_FLOBUFLEN (10+2*(sizeof(double)/sizeof(char)*SCM_CHAR_BIT*3+9)/10)
+
+#endif  /* SCM_DEBUG_DEPRECATED == 1 */
+
+

 /* IS_INF tests its floating point number for infiniteness
 /* IS_INF tests its floating point number for infiniteness

+   Dirk:FIXME:: This test does not work if x == 0

  */
 #ifndef IS_INF
 #define IS_INF(x) ((x) == (x) / 2)
 #endif
 
  */
 #ifndef IS_INF
 #define IS_INF(x) ((x) == (x) / 2)
 #endif
 

+

 /* Return true if X is not infinite and is not a NaN
 /* Return true if X is not infinite and is not a NaN

+   Dirk:FIXME:: Since IS_INF is broken, this test does not work if x == 0

  */
 #ifndef isfinite
 #define isfinite(x) (!IS_INF (x) && (x) == (x))
  */
 #ifndef isfinite
 #define isfinite(x) (!IS_INF (x) && (x) == (x))


@@ -76,6 +96,10 @@
 
 \f
 
 
 \f
 

+static SCM abs_most_negative_fixnum;
+
+\f
+

 
 SCM_DEFINE (scm_exact_p, "exact?", 1, 0, 0, 
             (SCM x),
 
 SCM_DEFINE (scm_exact_p, "exact?", 1, 0, 0, 
             (SCM x),


@@ -84,10 +108,8 @@ SCM_DEFINE (scm_exact_p, "exact?", 1, 0, 0,
 {
   if (SCM_INUMP (x)) {
     return SCM_BOOL_T;
 {
   if (SCM_INUMP (x)) {
     return SCM_BOOL_T;

-#ifdef SCM_BIGDIG

   } else if (SCM_BIGP (x)) {
     return SCM_BOOL_T;
   } else if (SCM_BIGP (x)) {
     return SCM_BOOL_T;

-#endif

   } else {
     return SCM_BOOL_F;
   }
   } else {
     return SCM_BOOL_F;
   }


@@ -102,10 +124,8 @@ SCM_DEFINE (scm_odd_p, "odd?", 1, 0, 0,
 {
   if (SCM_INUMP (n)) {
     return SCM_BOOL ((4 & SCM_UNPACK (n)) != 0);
 {
   if (SCM_INUMP (n)) {
     return SCM_BOOL ((4 & SCM_UNPACK (n)) != 0);

-#ifdef SCM_BIGDIG

   } else if (SCM_BIGP (n)) {
     return SCM_BOOL ((1 & SCM_BDIGITS (n) [0]) != 0);
   } else if (SCM_BIGP (n)) {
     return SCM_BOOL ((1 & SCM_BDIGITS (n) [0]) != 0);

-#endif

   } else {
     SCM_WRONG_TYPE_ARG (1, n);
   }
   } else {
     SCM_WRONG_TYPE_ARG (1, n);
   }


@@ -120,10 +140,8 @@ SCM_DEFINE (scm_even_p, "even?", 1, 0, 0,
 {
   if (SCM_INUMP (n)) {
     return SCM_BOOL ((4 & SCM_UNPACK (n)) == 0);
 {
   if (SCM_INUMP (n)) {
     return SCM_BOOL ((4 & SCM_UNPACK (n)) == 0);

-#ifdef SCM_BIGDIG

   } else if (SCM_BIGP (n)) {
     return SCM_BOOL ((1 & SCM_BDIGITS (n) [0]) == 0);
   } else if (SCM_BIGP (n)) {
     return SCM_BOOL ((1 & SCM_BDIGITS (n) [0]) == 0);

-#endif

   } else {
     SCM_WRONG_TYPE_ARG (1, n);
   }
   } else {
     SCM_WRONG_TYPE_ARG (1, n);
   }


@@ -149,14 +167,14 @@ scm_abs (SCM x)
       scm_num_overflow (s_abs);
 #endif
     }
       scm_num_overflow (s_abs);
 #endif
     }

-#ifdef SCM_BIGDIG

   } else if (SCM_BIGP (x)) {
     if (!SCM_BIGSIGN (x)) {
       return x;
     } else {
       return scm_copybig (x, 0);
     }
   } else if (SCM_BIGP (x)) {
     if (!SCM_BIGSIGN (x)) {
       return x;
     } else {
       return scm_copybig (x, 0);
     }

-#endif
+  } else if (SCM_REALP (x)) {
+    return scm_make_real (fabs (SCM_REAL_VALUE (x)));

   } else {
     SCM_WTA_DISPATCH_1 (g_abs, x, 1, s_abs);
   }
   } else {
     SCM_WTA_DISPATCH_1 (g_abs, x, 1, s_abs);
   }


@@ -176,19 +194,6 @@ scm_quotient (SCM x, SCM y)
        scm_num_overflow (s_quotient);
       } else {
        long z = xx / yy;
        scm_num_overflow (s_quotient);
       } else {
        long z = xx / yy;

-#ifdef BADIVSGNS
-       {
-#if (__TURBOC__ == 1)
-         long t = ((yy < 0) ? -xx : xx) % yy;
-#else
-         long t = xx % yy;
-#endif
-         if ((t < 0) && (xx > 0)) 
-           z--;
-         else if ((t > 0) && (xx < 0)) 
-           z++;
-       }
-#endif

        if (SCM_FIXABLE (z)) {
          return SCM_MAKINUM (z);
        } else {
        if (SCM_FIXABLE (z)) {
          return SCM_MAKINUM (z);
        } else {


@@ -199,14 +204,18 @@ scm_quotient (SCM x, SCM y)
 #endif
        }
       }
 #endif
        }
       }

-#ifdef SCM_BIGDIG

     } else if (SCM_BIGP (y)) {
     } else if (SCM_BIGP (y)) {

-      return SCM_INUM0;
-#endif
+      if (SCM_INUM (x) == SCM_MOST_NEGATIVE_FIXNUM
+         && scm_bigcomp (abs_most_negative_fixnum, y) == 0)
+       {
+         /* Special case:  x == fixnum-min && y == abs (fixnum-min) */
+         return SCM_MAKINUM (-1);
+       }
+      else
+       return SCM_MAKINUM (0);

     } else {
       SCM_WTA_DISPATCH_2 (g_quotient, x, y, SCM_ARG2, s_quotient);
     }
     } else {
       SCM_WTA_DISPATCH_2 (g_quotient, x, y, SCM_ARG2, s_quotient);
     }

-#ifdef SCM_BIGDIG

   } else if (SCM_BIGP (x)) {
     if (SCM_INUMP (y)) {
       long yy = SCM_INUM (y);
   } else if (SCM_BIGP (x)) {
     if (SCM_INUMP (y)) {
       long yy = SCM_INUM (y);


@@ -243,9 +252,8 @@ scm_quotient (SCM x, SCM y)
     } else {
       SCM_WTA_DISPATCH_2 (g_quotient, x, y, SCM_ARG2, s_quotient);
     }
     } else {
       SCM_WTA_DISPATCH_2 (g_quotient, x, y, SCM_ARG2, s_quotient);
     }

-#endif

   } else {
   } else {

-    SCM_WTA_DISPATCH_2 (g_quotient, x, y, SCM_ARG2, s_quotient);
+    SCM_WTA_DISPATCH_2 (g_quotient, x, y, SCM_ARG1, s_quotient);

   }
 }
 
   }
 }
 


@@ -255,58 +263,48 @@ SCM_GPROC (s_remainder, "remainder", 2, 0, 0, scm_remainder, g_remainder);
 SCM
 scm_remainder (SCM x, SCM y)
 {
 SCM
 scm_remainder (SCM x, SCM y)
 {

-  register long z;
-#ifdef SCM_BIGDIG
-  if (SCM_NINUMP (x))
-    {
-      SCM_GASSERT2 (SCM_BIGP (x),
-                   g_remainder, x, y, SCM_ARG1, s_remainder);
-      if (SCM_NINUMP (y))
-       {
-         SCM_ASRTGO (SCM_BIGP (y), bady);
-         return scm_divbigbig (SCM_BDIGITS (x), SCM_NUMDIGS (x),
-                               SCM_BDIGITS (y), SCM_NUMDIGS (y),
-                               SCM_BIGSIGN (x), 0);
-       }
-      if (!(z = SCM_INUM (y)))
-       goto ov;
-      return scm_divbigint (x, z, SCM_BIGSIGN (x), 0);
-    }
-  if (SCM_NINUMP (y))
-    {
-      if (!SCM_BIGP (y))
+  if (SCM_INUMP (x)) {
+    if (SCM_INUMP (y)) {
+      long yy = SCM_INUM (y);
+      if (yy == 0) {
+       scm_num_overflow (s_remainder);
+      } else {
+       long z = SCM_INUM (x) % yy;
+       return SCM_MAKINUM (z);
+      }
+    } else if (SCM_BIGP (y)) {
+      if (SCM_INUM (x) == SCM_MOST_NEGATIVE_FIXNUM
+         && scm_bigcomp (abs_most_negative_fixnum, y) == 0)

        {
        {

-       bady:
-         SCM_WTA_DISPATCH_2 (g_remainder, x, y, SCM_ARG2, s_remainder);
+         /* Special case:  x == fixnum-min && y == abs (fixnum-min) */
+         return SCM_MAKINUM (0);

        }
        }

-      return x;
+      else
+       return x;
+    } else {
+      SCM_WTA_DISPATCH_2 (g_remainder, x, y, SCM_ARG2, s_remainder);

     }
     }

-#else
-  SCM_GASSERT2 (SCM_INUMP (x), g_remainder, x, y, SCM_ARG1, s_remainder);
-  SCM_GASSERT2 (SCM_INUMP (y), g_remainder, x, y, SCM_ARG2, s_remainder);
-#endif
-  if (!(z = SCM_INUM (y)))
-    {
-    ov:
-      scm_num_overflow (s_remainder);
+  } else if (SCM_BIGP (x)) {
+    if (SCM_INUMP (y)) {
+      long yy = SCM_INUM (y);
+      if (yy == 0) {
+       scm_num_overflow (s_remainder);
+      } else {
+       return scm_divbigint (x, yy, SCM_BIGSIGN (x), 0);
+      }
+    } else if (SCM_BIGP (y)) {
+      return scm_divbigbig (SCM_BDIGITS (x), SCM_NUMDIGS (x),
+                           SCM_BDIGITS (y), SCM_NUMDIGS (y),
+                           SCM_BIGSIGN (x), 0);
+    } else {
+      SCM_WTA_DISPATCH_2 (g_remainder, x, y, SCM_ARG2, s_remainder);

     }
     }

-#if (__TURBOC__ == 1)
-  if (z < 0)
-    z = -z;
-#endif
-  z = SCM_INUM (x) % z;
-#ifdef BADIVSGNS
-  if (!z);
-  else if (z < 0)
-    if (x < 0);
-    else
-      z += SCM_INUM (y);
-  else if (x < 0)
-    z -= SCM_INUM (y);
-#endif
-  return SCM_MAKINUM (z);
+  } else {
+    SCM_WTA_DISPATCH_2 (g_remainder, x, y, SCM_ARG1, s_remainder);
+  }

 }
 
 }
 

+

 SCM_GPROC (s_modulo, "modulo", 2, 0, 0, scm_modulo, g_modulo);
 
 SCM
 SCM_GPROC (s_modulo, "modulo", 2, 0, 0, scm_modulo, g_modulo);
 
 SCM


@@ -319,37 +317,16 @@ scm_modulo (SCM x, SCM y)
       if (yy == 0) {
        scm_num_overflow (s_modulo);
       } else {
       if (yy == 0) {
        scm_num_overflow (s_modulo);
       } else {

-#if (__TURBOC__ == 1)
-       long z = ((yy < 0) ? -xx : xx) % yy;
-#else

        long z = xx % yy;
        long z = xx % yy;

-#endif

        return SCM_MAKINUM (((yy < 0) ? (z > 0) : (z < 0)) ? z + yy : z);
       }
        return SCM_MAKINUM (((yy < 0) ? (z > 0) : (z < 0)) ? z + yy : z);
       }

+    } else if (SCM_BIGP (y)) {
+      return (SCM_BIGSIGN (y) ? (xx > 0) : (xx < 0)) ? scm_sum (x, y) : x;

     } else {
     } else {

-#ifdef SCM_BIGDIG
-      if (!SCM_BIGP (y)) {
-       SCM_WTA_DISPATCH_2 (g_modulo, x, y, SCM_ARG2, s_modulo);
-      } else {
-       return (SCM_BIGSIGN (y) ? (xx > 0) : (xx < 0)) ? scm_sum (x, y) : x;
-      }
-#else

       SCM_WTA_DISPATCH_2 (g_modulo, x, y, SCM_ARG2, s_modulo);
       SCM_WTA_DISPATCH_2 (g_modulo, x, y, SCM_ARG2, s_modulo);

-#endif

     }
     }

-  } else {
-#ifdef SCM_BIGDIG
-    SCM_GASSERT2 (SCM_BIGP (x), g_modulo, x, y, SCM_ARG1, s_modulo);
-    if (SCM_NINUMP (y)) {
-      if (!SCM_BIGP (y)) {
-       SCM_WTA_DISPATCH_2 (g_modulo, x, y, SCM_ARG2, s_modulo);
-      } else {
-       return scm_divbigbig (SCM_BDIGITS (x), SCM_NUMDIGS (x),
-                             SCM_BDIGITS (y), SCM_NUMDIGS (y),
-                             SCM_BIGSIGN (y),
-                             (SCM_BIGSIGN (x) ^ SCM_BIGSIGN (y)) ? 1 : 0);
-      }
-    } else {
+  } else if (SCM_BIGP (x)) {
+    if (SCM_INUMP (y)) {

       long yy = SCM_INUM (y);
       if (yy == 0) {
        scm_num_overflow (s_modulo);
       long yy = SCM_INUM (y);
       if (yy == 0) {
        scm_num_overflow (s_modulo);


@@ -357,146 +334,167 @@ scm_modulo (SCM x, SCM y)
        return scm_divbigint (x, yy, yy < 0,
                              (SCM_BIGSIGN (x) ? (yy > 0) : (yy < 0)) ? 1 : 0);
       }
        return scm_divbigint (x, yy, yy < 0,
                              (SCM_BIGSIGN (x) ? (yy > 0) : (yy < 0)) ? 1 : 0);
       }

+    } else if (SCM_BIGP (y)) {
+      return scm_divbigbig (SCM_BDIGITS (x), SCM_NUMDIGS (x),
+                           SCM_BDIGITS (y), SCM_NUMDIGS (y),
+                           SCM_BIGSIGN (y),
+                           (SCM_BIGSIGN (x) ^ SCM_BIGSIGN (y)) ? 1 : 0);
+    } else {
+      SCM_WTA_DISPATCH_2 (g_modulo, x, y, SCM_ARG2, s_modulo);

     }
     }

-#else
-    SCM_WTA_DISPATCH_2 (g_modulo, x, y, SCM_ARG2, s_modulo);
-#endif
+  } else {
+    SCM_WTA_DISPATCH_2 (g_modulo, x, y, SCM_ARG1, s_modulo);

   }
 }
 
   }
 }
 

+

 SCM_GPROC1 (s_gcd, "gcd", scm_tc7_asubr, scm_gcd, g_gcd);
 
 SCM
 scm_gcd (SCM x, SCM y)
 {
 SCM_GPROC1 (s_gcd, "gcd", scm_tc7_asubr, scm_gcd, g_gcd);
 
 SCM
 scm_gcd (SCM x, SCM y)
 {

-  long u, v, k, t;
-  if (SCM_UNBNDP (y))
-    return SCM_UNBNDP (x) ? SCM_INUM0 : x;
+  if (SCM_UNBNDP (y)) {
+    if (SCM_UNBNDP (x)) {
+      return SCM_INUM0;
+    } else {
+      return x;
+    }
+  }
+

  tailrec:
  tailrec:

-#ifdef SCM_BIGDIG
-  if (SCM_NINUMP (x))
-    {
-    big_gcd:
-      SCM_GASSERT2 (SCM_BIGP (x),
-                   g_gcd, x, y, SCM_ARG1, s_gcd);
-      if (SCM_BIGSIGN (x))
-       x = scm_copybig (x, 0);
-    newy:
-      if (SCM_NINUMP (y))
-       {
-         SCM_GASSERT2 (SCM_BIGP (y),
-                       g_gcd, x, y, SCM_ARGn, s_gcd);
-         if (SCM_BIGSIGN (y))
-           y = scm_copybig (y, 0);
-         switch (scm_bigcomp (x, y))
-           {
-           case -1:
-           swaprec:
-           {
-             SCM t = scm_remainder (x, y);
-             x = y;
-             y = t;
-           }
-           goto tailrec;
-           case 0:
-             return x;
-           case 1:
-             y = scm_remainder (y, x);
-             goto newy;
-           }
-         /* instead of the switch, we could just
-            return scm_gcd (y, scm_modulo (x, y)); */
+  if (SCM_INUMP (x)) {
+    if (SCM_INUMP (y)) {
+      long xx = SCM_INUM (x);
+      long yy = SCM_INUM (y);
+      long u = xx < 0 ? -xx : xx;
+      long v = yy < 0 ? -yy : yy;
+      long result;
+
+      if (xx == 0) {
+       result = v;
+      } else if (yy == 0) {
+       result = u;
+      } else {
+       int k = 1;
+       long t;
+
+       /* Determine a common factor 2^k */
+       while (!(1 & (u | v))) {
+         k <<= 1;
+         u >>= 1;
+         v >>= 1;

        }
        }

-      if (SCM_EQ_P (y, SCM_INUM0))
-       return x;
-      goto swaprec;
-    }
-  if (SCM_NINUMP (y))
-    {
-      SCM t = x;
-      x = y;
-      y = t;
-      goto big_gcd;
-    }
-#else
-  SCM_GASSERT2 (SCM_INUMP (x), g_gcd, x, y, SCM_ARG1, s_gcd);
-  SCM_GASSERT2 (SCM_INUMP (y), g_gcd, x, y, SCM_ARGn, s_gcd);
-#endif
-  u = SCM_INUM (x);
-  if (u < 0)
-    u = -u;
-  v = SCM_INUM (y);
-  if (v < 0)
-    v = -v;
-  else if (0 == v)
-    goto getout;
-  if (0 == u)
-    {
-      u = v;
-      goto getout;
-    }
-  for (k = 1; !(1 & ((int) u | (int) v)); k <<= 1, u >>= 1, v >>= 1);
-  if (1 & (int) u)
-    t = -v;
-  else
-    {
-      t = u;
-    b3:
-      t = SCM_SRS (t, 1);
-    }
-  if (!(1 & (int) t))
-    goto b3;
-  if (t > 0)
-    u = t;
-  else
-    v = -t;
-  if ((t = u - v))
-    goto b3;
-  u = u * k;
- getout:
-  if (!SCM_POSFIXABLE (u))
+
+       /* Now, any factor 2^n can be eliminated */
+       if (u & 1) {
+         t = -v;
+       } else {
+         t = u;
+       b3:
+         t = SCM_SRS (t, 1);
+       }
+       if (!(1 & t))
+         goto b3;
+       if (t > 0)
+         u = t;
+       else
+         v = -t;
+       t = u - v;
+       if (t != 0)
+         goto b3;
+
+       result = u * k;
+      }
+      if (SCM_POSFIXABLE (result)) {
+       return SCM_MAKINUM (result);
+      } else {

 #ifdef SCM_BIGDIG
 #ifdef SCM_BIGDIG

-    return scm_long2big (u);
+       return scm_long2big (result);

 #else
 #else

-  scm_num_overflow (s_gcd);
+       scm_num_overflow (s_gcd);

 #endif
 #endif

-  return SCM_MAKINUM (u);
+      }
+    } else if (SCM_BIGP (y)) {
+      SCM_SWAP (x, y);
+      goto big_gcd;
+    } else {
+      SCM_WTA_DISPATCH_2 (g_gcd, x, y, SCM_ARG2, s_gcd);
+    }
+  } else if (SCM_BIGP (x)) {
+  big_gcd:
+    if (SCM_BIGSIGN (x))
+      x = scm_copybig (x, 0);
+  newy:
+    if (SCM_INUMP (y)) {
+      if (SCM_EQ_P (y, SCM_INUM0)) {
+       return x;
+      } else {
+       goto swaprec;
+      }
+    } else if (SCM_BIGP (y)) {
+      if (SCM_BIGSIGN (y))
+       y = scm_copybig (y, 0);
+      switch (scm_bigcomp (x, y))
+       {
+       case -1:  /* x > y */
+       swaprec:
+       {
+         SCM t = scm_remainder (x, y);
+         x = y;
+         y = t;
+       }
+       goto tailrec;
+       case 1:  /* x < y */
+         y = scm_remainder (y, x);
+         goto newy;
+       default:  /* x == y */
+         return x;
+       }
+      /* instead of the switch, we could just
+        return scm_gcd (y, scm_modulo (x, y)); */
+    } else {
+      SCM_WTA_DISPATCH_2 (g_gcd, x, y, SCM_ARG2, s_gcd);
+    }
+  } else {
+    SCM_WTA_DISPATCH_2 (g_gcd, x, y, SCM_ARG1, s_gcd);
+  }

 }
 
 }
 

+

 SCM_GPROC1 (s_lcm, "lcm", scm_tc7_asubr, scm_lcm, g_lcm);
 
 SCM
 scm_lcm (SCM n1, SCM n2)
 {
 SCM_GPROC1 (s_lcm, "lcm", scm_tc7_asubr, scm_lcm, g_lcm);
 
 SCM
 scm_lcm (SCM n1, SCM n2)
 {

-  SCM d;
+  if (SCM_UNBNDP (n2)) {
+    if (SCM_UNBNDP (n1)) {
+      return SCM_MAKINUM (1L);
+    } else {
+      n2 = SCM_MAKINUM (1L);
+    }
+  };
+

 #ifndef SCM_BIGDIG
 #ifndef SCM_BIGDIG

-  SCM_GASSERT2 (SCM_INUMP (n1) || SCM_UNBNDP (n1),
-               g_lcm, n1, n2, SCM_ARG1, s_lcm);
-  SCM_GASSERT2 (SCM_INUMP (n2) || SCM_UNBNDP (n2),
-               g_lcm, n1, n2, SCM_ARGn, s_lcm);
+  SCM_GASSERT2 (SCM_INUMP (n1), g_lcm, n1, n2, SCM_ARG1, s_lcm);
+  SCM_GASSERT2 (SCM_INUMP (n2), g_lcm, n1, n2, SCM_ARGn, s_lcm);

 #else
 #else

-  SCM_GASSERT2 (SCM_INUMP (n1)
-               || SCM_UNBNDP (n1)
-               || (SCM_BIGP (n1)),
+  SCM_GASSERT2 (SCM_INUMP (n1) || SCM_BIGP (n1),

                g_lcm, n1, n2, SCM_ARG1, s_lcm);
                g_lcm, n1, n2, SCM_ARG1, s_lcm);

-  SCM_GASSERT2 (SCM_INUMP (n2)
-               || SCM_UNBNDP (n2)
-               || (SCM_BIGP (n2)),
+  SCM_GASSERT2 (SCM_INUMP (n2) || SCM_BIGP (n2),

                g_lcm, n1, n2, SCM_ARGn, s_lcm);
 #endif
                g_lcm, n1, n2, SCM_ARGn, s_lcm);
 #endif

-  if (SCM_UNBNDP (n2))
-    {
-      n2 = SCM_MAKINUM (1L);
-      if (SCM_UNBNDP (n1))
-       return n2;
+
+  {
+    SCM d = scm_gcd (n1, n2);
+    if (SCM_EQ_P (d, SCM_INUM0)) {
+      return d;
+    } else {
+      return scm_abs (scm_product (n1, scm_quotient (n2, d)));

     }
     }

-  
-  d = scm_gcd (n1, n2);
-  if (SCM_EQ_P (d, SCM_INUM0))
-    return d;
-  return scm_abs (scm_product (n1, scm_quotient (n2, d)));
+  }

 }
 
 }
 

+

 #ifndef scm_long2num
 #define SCM_LOGOP_RETURN(x) scm_ulong2num(x)
 #else
 #ifndef scm_long2num
 #define SCM_LOGOP_RETURN(x) scm_ulong2num(x)
 #else


@@ -674,12 +672,14 @@ SCM scm_big_and(SCM_BIGDIG *x, scm_sizet nx, int xsgn, SCM bigy, int zsgn)
       if (!num) return scm_normbig(z);
     }
   }
       if (!num) return scm_normbig(z);
     }
   }

-  else if (xsgn) do {
-    num += x[i];
-    if (num < 0) {zds[i] &= num + SCM_BIGRAD; num = -1;}
-    else {zds[i] &= ~SCM_BIGLO(num); num = 0;}
-  } while (++i < nx);
-  else do zds[i] = zds[i] & x[i]; while (++i < nx);
+  else if (xsgn) {
+    unsigned long int carry = 1;
+    do {
+      unsigned long int mask = (SCM_BIGDIG) ~x[i] + carry;
+      zds[i] = zds[i] & (SCM_BIGDIG) mask;
+      carry = (mask >= SCM_BIGRAD) ? 1 : 0;
+    } while (++i < nx);
+  } else do zds[i] = zds[i] & x[i]; while (++i < nx);

   return scm_normbig(z);
 }
 
   return scm_normbig(z);
 }
 


@@ -725,6 +725,7 @@ SCM scm_big_test(SCM_BIGDIG *x, scm_sizet nx, int xsgn, SCM bigy)
 
 #endif
 
 
 #endif
 

+

 SCM_DEFINE1 (scm_logand, "logand", scm_tc7_asubr,
              (SCM n1, SCM n2),
             "Returns the integer which is the bit-wise AND of the two integer\n"
 SCM_DEFINE1 (scm_logand, "logand", scm_tc7_asubr,
              (SCM n1, SCM n2),
             "Returns the integer which is the bit-wise AND of the two integer\n"


@@ -732,64 +733,86 @@ SCM_DEFINE1 (scm_logand, "logand", scm_tc7_asubr,
             "Example:\n"
             "@lisp\n"
             "(number->string (logand #b1100 #b1010) 2)\n"
             "Example:\n"
             "@lisp\n"
             "(number->string (logand #b1100 #b1010) 2)\n"

-            "   @result{} \"1000\"")
+            "   @result{} \"1000\"\n"
+            "@end lisp")

 #define FUNC_NAME s_scm_logand
 {
 #define FUNC_NAME s_scm_logand
 {

-  if (SCM_UNBNDP (n2))
-    {
-      if (SCM_UNBNDP (n1))
-       return SCM_MAKINUM (-1);
+  long int nn1;
+
+  if (SCM_UNBNDP (n2)) {
+    if (SCM_UNBNDP (n1)) {
+      return SCM_MAKINUM (-1);
+    } else if (!SCM_NUMBERP (n1)) {
+      SCM_WRONG_TYPE_ARG (SCM_ARG1, n1);

 #ifndef SCM_RECKLESS
 #ifndef SCM_RECKLESS

-      if (!(SCM_NUMBERP (n1)))
-         badx: SCM_WTA (SCM_ARG1, n1);
-#endif
+    } else if (SCM_NUMBERP (n1)) {
+      return n1;
+    } else {
+      SCM_WRONG_TYPE_ARG (SCM_ARG1, n1);
+#else
+    } else {

       return n1;
       return n1;

+#endif

     }
     }

-#ifdef SCM_BIGDIG
-  if SCM_NINUMP(n1) {
-    SCM t;
-    SCM_ASRTGO(SCM_NIMP(n1) && SCM_BIGP(n1), badx);
-    if SCM_INUMP(n2) {t = n1; n1 = n2; n2 = t; goto intbig;}
-    SCM_ASRTGO(SCM_NIMP(n2) && SCM_BIGP(n2), bady);
-    if (SCM_NUMDIGS(n1) > SCM_NUMDIGS(n2)) {t = n1; n1 = n2; n2 = t;}
-    if ((SCM_BIGSIGN(n1)) && SCM_BIGSIGN(n2))
-      return scm_big_ior (SCM_BDIGITS(n1),
-                         SCM_NUMDIGS(n1),
-                         SCM_BIGSIGNFLAG,
-                         n2);
-    return scm_big_and (SCM_BDIGITS(n1),
-                       SCM_NUMDIGS(n1),
-                       SCM_BIGSIGN(n1),
-                       n2,
-                       0);

   }
   }

-  if SCM_NINUMP(n2) {
-# ifndef SCM_RECKLESS
-      if (!(SCM_NIMP(n2) && SCM_BIGP(n2)))
-         bady: SCM_WTA (SCM_ARG2, n2);
-# endif
-  intbig: {
+
+  if (SCM_INUMP (n1)) {
+    nn1 = SCM_INUM (n1);
+    if (SCM_INUMP (n2)) {
+      long nn2 = SCM_INUM (n2);
+      return SCM_MAKINUM (nn1 & nn2);
+    } else if SCM_BIGP (n2) {
+    intbig: 
+      {

 # ifndef SCM_DIGSTOOBIG
 # ifndef SCM_DIGSTOOBIG

-    long z = scm_pseudolong(SCM_INUM(n1));
-    if ((n1 < 0) && SCM_BIGSIGN(n2))
-      return scm_big_ior((SCM_BIGDIG *)&z, SCM_DIGSPERLONG, SCM_BIGSIGNFLAG, n2);
-    return scm_big_and((SCM_BIGDIG *)&z, SCM_DIGSPERLONG, (n1 < 0) ? SCM_BIGSIGNFLAG : 0, n2, 0);
+       long z = scm_pseudolong (nn1);
+       if ((nn1 < 0) && SCM_BIGSIGN (n2)) {
+         return scm_big_ior ((SCM_BIGDIG *) & z, SCM_DIGSPERLONG, 
+                             SCM_BIGSIGNFLAG, n2);
+       } else {
+         return scm_big_and ((SCM_BIGDIG *) & z, SCM_DIGSPERLONG, 
+                             (nn1 < 0) ? SCM_BIGSIGNFLAG : 0, n2, 0);
+       }

 # else
 # else

-    SCM_BIGDIG zdigs[SCM_DIGSPERLONG];
-    scm_longdigs(SCM_INUM(n1), zdigs);
-    if ((n1 < 0) && SCM_BIGSIGN(n2))
-      return scm_big_ior(zdigs, SCM_DIGSPERLONG, SCM_BIGSIGNFLAG, n2);
-    return scm_big_and(zdigs, SCM_DIGSPERLONG, (n1 < 0) ? SCM_BIGSIGNFLAG : 0, n2, 0);
+       SCM_BIGDIG zdigs [SCM_DIGSPERLONG];
+       scm_longdigs (nn1, zdigs);
+       if ((nn1 < 0) && SCM_BIGSIGN (n2)) {
+         return scm_big_ior (zdigs, SCM_DIGSPERLONG, SCM_BIGSIGNFLAG, n2);
+       } else {
+         return scm_big_and (zdigs, SCM_DIGSPERLONG, 
+                             (nn1 < 0) ? SCM_BIGSIGNFLAG : 0, n2, 0);
+       }

 # endif
 # endif

-  }}
-#else
-  SCM_ASRTGO(SCM_INUMP(n1), badx);
-  SCM_ASSERT(SCM_INUMP(n2), n2, SCM_ARG2, FUNC_NAME);
-#endif
-  return SCM_MAKINUM(SCM_INUM(n1) & SCM_INUM(n2));
+      }
+    } else {
+      SCM_WRONG_TYPE_ARG (SCM_ARG2, n2);
+    }
+  } else if (SCM_BIGP (n1)) {
+    if (SCM_INUMP (n2)) {
+      SCM_SWAP (n1, n2);
+      nn1 = SCM_INUM (n1);
+      goto intbig;
+    } else if (SCM_BIGP (n2)) {
+      if (SCM_NUMDIGS (n1) > SCM_NUMDIGS (n2)) {
+       SCM_SWAP (n1, n2);
+      };
+      if ((SCM_BIGSIGN (n1)) && SCM_BIGSIGN (n2)) {
+       return scm_big_ior (SCM_BDIGITS (n1), SCM_NUMDIGS (n1),
+                           SCM_BIGSIGNFLAG, n2);
+      } else {
+       return scm_big_and (SCM_BDIGITS (n1), SCM_NUMDIGS (n1),
+                           SCM_BIGSIGN (n1), n2, 0);
+      }
+    } else {
+      SCM_WRONG_TYPE_ARG (SCM_ARG2, n2);
+    }
+  } else {
+    SCM_WRONG_TYPE_ARG (SCM_ARG1, n1);
+  }

 }
 #undef FUNC_NAME
 
 }
 #undef FUNC_NAME
 

+

 SCM_DEFINE1 (scm_logior, "logior", scm_tc7_asubr,
              (SCM n1, SCM n2),
             "Returns the integer which is the bit-wise OR of the two integer\n"
 SCM_DEFINE1 (scm_logior, "logior", scm_tc7_asubr,
              (SCM n1, SCM n2),
             "Returns the integer which is the bit-wise OR of the two integer\n"


@@ -801,54 +824,81 @@ SCM_DEFINE1 (scm_logior, "logior", scm_tc7_asubr,
             "@end lisp")
 #define FUNC_NAME s_scm_logior
 {
             "@end lisp")
 #define FUNC_NAME s_scm_logior
 {

-  if (SCM_UNBNDP (n2))
-    {
-      if (SCM_UNBNDP (n1))
-       return SCM_INUM0;
+  long int nn1;
+
+  if (SCM_UNBNDP (n2)) {
+    if (SCM_UNBNDP (n1)) {
+      return SCM_INUM0;

 #ifndef SCM_RECKLESS
 #ifndef SCM_RECKLESS

-    if (!(SCM_NUMBERP(n1)))
-    badx: SCM_WTA(SCM_ARG1, n1);
-#endif
+    } else if (SCM_NUMBERP (n1)) {
+      return n1;
+    } else {
+      SCM_WRONG_TYPE_ARG (SCM_ARG1, n1);
+#else
+    } else {

       return n1;
       return n1;

+#endif

     }
     }

-#ifdef SCM_BIGDIG
-  if SCM_NINUMP(n1) {
-    SCM t;
-    SCM_ASRTGO(SCM_NIMP(n1) && SCM_BIGP(n1), badx);
-    if SCM_INUMP(n2) {t = n1; n1 = n2; n2 = t; goto intbig;}
-    SCM_ASRTGO(SCM_NIMP(n2) && SCM_BIGP(n2), bady);
-    if (SCM_NUMDIGS(n1) > SCM_NUMDIGS(n2)) {t = n1; n1 = n2; n2 = t;}
-    if ((!SCM_BIGSIGN(n1)) && !SCM_BIGSIGN(n2))
-      return scm_big_ior(SCM_BDIGITS(n1), SCM_NUMDIGS(n1), SCM_BIGSIGN(n1), n2);
-    return scm_big_and(SCM_BDIGITS(n1), SCM_NUMDIGS(n1), SCM_BIGSIGN(n1), n2, SCM_BIGSIGNFLAG);

   }
   }

-  if SCM_NINUMP(n2) {
-# ifndef SCM_RECKLESS
-    if (!(SCM_NIMP(n2) && SCM_BIGP(n2)))
-    bady: SCM_WTA(SCM_ARG2, n2);
-# endif
-  intbig: {
+
+  if (SCM_INUMP (n1)) {
+    nn1 = SCM_INUM (n1);
+    if (SCM_INUMP (n2)) {
+      long nn2 = SCM_INUM (n2);
+      return SCM_MAKINUM (nn1 | nn2);
+    } else if (SCM_BIGP (n2)) {
+    intbig:
+      {

 # ifndef SCM_DIGSTOOBIG
 # ifndef SCM_DIGSTOOBIG

-    long z = scm_pseudolong(SCM_INUM(n1));
-    if ((!(n1 < 0)) && !SCM_BIGSIGN(n2))
-      return scm_big_ior((SCM_BIGDIG *)&z, SCM_DIGSPERLONG, (n1 < 0) ? SCM_BIGSIGNFLAG : 0, n2);
-    return scm_big_and((SCM_BIGDIG *)&z, SCM_DIGSPERLONG, (n1 < 0) ? SCM_BIGSIGNFLAG : 0, n2, SCM_BIGSIGNFLAG);
+       long z = scm_pseudolong (nn1);
+       if ((!(nn1 < 0)) && !SCM_BIGSIGN (n2)) {
+         return scm_big_ior ((SCM_BIGDIG *) & z, SCM_DIGSPERLONG, 
+                             (nn1 < 0) ? SCM_BIGSIGNFLAG : 0, n2);
+       } else {
+         return scm_big_and ((SCM_BIGDIG *) & z, SCM_DIGSPERLONG, 
+                             (nn1 < 0) ? SCM_BIGSIGNFLAG : 0, n2, SCM_BIGSIGNFLAG);
+       }

 # else
 # else

-    BIGDIG zdigs[DIGSPERLONG];
-    scm_longdigs(SCM_INUM(n1), zdigs);
-    if ((!(n1 < 0)) && !SCM_BIGSIGN(n2))
-      return scm_big_ior(zdigs, SCM_DIGSPERLONG, (n1 < 0) ? SCM_BIGSIGNFLAG : 0, n2);
-    return scm_big_and(zdigs, SCM_DIGSPERLONG, (n1 < 0) ? SCM_BIGSIGNFLAG : 0, n2, SCM_BIGSIGNFLAG);
+       BIGDIG zdigs [DIGSPERLONG];
+       scm_longdigs (nn1, zdigs);
+       if ((!(nn1 < 0)) && !SCM_BIGSIGN (n2)) {
+         return scm_big_ior (zdigs, SCM_DIGSPERLONG, 
+                             (nn1 < 0) ? SCM_BIGSIGNFLAG : 0, n2);
+       } else {
+         return scm_big_and (zdigs, SCM_DIGSPERLONG, 
+                             (nn1 < 0) ? SCM_BIGSIGNFLAG : 0, n2, SCM_BIGSIGNFLAG);
+       }

 # endif
 # endif

-  }}
-#else
-  SCM_ASRTGO(SCM_INUMP(n1), badx);
-  SCM_ASSERT(SCM_INUMP(n2), n2, SCM_ARG2, FUNC_NAME);
-#endif
-  return SCM_MAKINUM(SCM_INUM(n1) | SCM_INUM(n2));
+      }
+    } else {
+      SCM_WRONG_TYPE_ARG (SCM_ARG2, n2);
+    }
+  } else if (SCM_BIGP (n1)) {
+    if (SCM_INUMP (n2)) {
+      SCM_SWAP (n1, n2); 
+      nn1 = SCM_INUM (n1);
+      goto intbig;
+    } else if (SCM_BIGP (n2)) {
+      if (SCM_NUMDIGS (n1) > SCM_NUMDIGS (n2)) {
+       SCM_SWAP (n1, n2);
+      };
+      if ((!SCM_BIGSIGN (n1)) && !SCM_BIGSIGN (n2)) {
+       return scm_big_ior (SCM_BDIGITS (n1), SCM_NUMDIGS (n1), 
+                           SCM_BIGSIGN (n1), n2);
+      } else {
+       return scm_big_and (SCM_BDIGITS (n1), SCM_NUMDIGS (n1), 
+                           SCM_BIGSIGN (n1), n2, SCM_BIGSIGNFLAG);
+      }
+    } else {
+      SCM_WRONG_TYPE_ARG (SCM_ARG2, n2);
+    }
+  } else {
+    SCM_WRONG_TYPE_ARG (SCM_ARG1, n1);
+  }

 }
 #undef FUNC_NAME
 
 }
 #undef FUNC_NAME
 

+

 SCM_DEFINE1 (scm_logxor, "logxor", scm_tc7_asubr,
              (SCM n1, SCM n2),
             "Returns the integer which is the bit-wise XOR of the two integer\n"
 SCM_DEFINE1 (scm_logxor, "logxor", scm_tc7_asubr,
              (SCM n1, SCM n2),
             "Returns the integer which is the bit-wise XOR of the two integer\n"


@@ -860,61 +910,66 @@ SCM_DEFINE1 (scm_logxor, "logxor", scm_tc7_asubr,
             "@end lisp")
 #define FUNC_NAME s_scm_logxor
 {
             "@end lisp")
 #define FUNC_NAME s_scm_logxor
 {

-  if (SCM_UNBNDP (n2))
-    {
-      if (SCM_UNBNDP (n1))
-       return SCM_INUM0;
+  long int nn1;
+
+  if (SCM_UNBNDP (n2)) {
+    if (SCM_UNBNDP (n1)) {
+      return SCM_INUM0;

 #ifndef SCM_RECKLESS
 #ifndef SCM_RECKLESS

-      if (!(SCM_NUMBERP(n1)))
-         badx: SCM_WTA(SCM_ARG1, n1);
-#endif
+    } else if (SCM_NUMBERP (n1)) {

       return n1;
       return n1;

+    } else {
+      SCM_WRONG_TYPE_ARG (SCM_ARG1, n1);
+#else
+    } else {
+      return n1;
+#endif

     }
     }

-#ifdef SCM_BIGDIG
-  if SCM_NINUMP(n1) {
-      SCM t;
-      SCM_ASRTGO(SCM_NIMP(n1) && SCM_BIGP(n1), badx);
-      if SCM_INUMP(n2)
-         {
-             t = n1;
-             n1 = n2;
-             n2 = t;
-             goto intbig;
-         }
-      SCM_ASRTGO(SCM_NIMP(n2) && SCM_BIGP(n2), bady);
-      if (SCM_NUMDIGS(n1) > SCM_NUMDIGS(n2))
-          {
-             t = n1;
-             n1 = n2;
-             n2 = t;
-         }
-      return scm_big_xor(SCM_BDIGITS(n1), SCM_NUMDIGS(n1), SCM_BIGSIGN(n1), n2);

   }
   }

-  if SCM_NINUMP(n2) {
-# ifndef SCM_RECKLESS
-  if (!(SCM_NIMP(n2) && SCM_BIGP(n2)))
-  bady: SCM_WTA (SCM_ARG2, n2);
-# endif
-  intbig: 
+
+  if (SCM_INUMP (n1)) {
+    nn1 = SCM_INUM (n1);
+    if (SCM_INUMP (n2)) {
+      long nn2 = SCM_INUM (n2);
+      return SCM_MAKINUM (nn1 ^ nn2);
+    } else if (SCM_BIGP (n2)) {
+    intbig: 

       {
 # ifndef SCM_DIGSTOOBIG
       {
 # ifndef SCM_DIGSTOOBIG

-         long z = scm_pseudolong(SCM_INUM(n1));
-         return scm_big_xor((SCM_BIGDIG *)&z, SCM_DIGSPERLONG, (n1 < 0) ? SCM_BIGSIGNFLAG : 0, n2);
+       long z = scm_pseudolong (nn1);
+       return scm_big_xor ((SCM_BIGDIG *) & z, SCM_DIGSPERLONG, 
+                           (nn1 < 0) ? SCM_BIGSIGNFLAG : 0, n2);

 # else
 # else

-         SCM_BIGDIG zdigs[SCM_DIGSPERLONG];
-         scm_longdigs(SCM_INUM(n1), zdigs);
-         return scm_big_xor(zdigs, SCM_DIGSPERLONG, (n1 < 0) ? SCM_BIGSIGNFLAG : 0, n2);
+       SCM_BIGDIG zdigs [SCM_DIGSPERLONG];
+       scm_longdigs (nn1, zdigs);
+       return scm_big_xor (zdigs, SCM_DIGSPERLONG, 
+                           (nn1 < 0) ? SCM_BIGSIGNFLAG : 0, n2);

 # endif
       }
 # endif
       }

-  }
-#else
-  SCM_ASRTGO(INUMP(n1), badx);
-  SCM_ASSERT(INUMP(n2), n2, SCM_ARG2, FUNC_NAME);
-#endif
-  return SCM_MAKINUM(SCM_INUM(n1) ^ SCM_INUM(n2));
-}
+    } else {
+      SCM_WRONG_TYPE_ARG (SCM_ARG2, n2);
+    }
+  } else if (SCM_BIGP (n1)) {
+    if (SCM_INUMP (n2)) {
+      SCM_SWAP (n1, n2);
+      nn1 = SCM_INUM (n1);
+      goto intbig;
+    } else if (SCM_BIGP (n2)) {
+      if (SCM_NUMDIGS(n1) > SCM_NUMDIGS(n2)) {
+       SCM_SWAP (n1, n2);
+      }
+      return scm_big_xor (SCM_BDIGITS (n1), SCM_NUMDIGS (n1), 
+                         SCM_BIGSIGN (n1), n2);
+    } else {
+      SCM_WRONG_TYPE_ARG (SCM_ARG2, n2);
+    }
+  } else {
+    SCM_WRONG_TYPE_ARG (SCM_ARG1, n1);
+  }
+}

 #undef FUNC_NAME
 
 #undef FUNC_NAME
 

+

 SCM_DEFINE (scm_logtest, "logtest", 2, 0, 0,
             (SCM n1, SCM n2),
            "@example\n"
 SCM_DEFINE (scm_logtest, "logtest", 2, 0, 0,
             (SCM n1, SCM n2),
            "@example\n"


@@ -924,39 +979,47 @@ SCM_DEFINE (scm_logtest, "logtest", 2, 0, 0,
            "@end example")
 #define FUNC_NAME s_scm_logtest
 {
            "@end example")
 #define FUNC_NAME s_scm_logtest
 {

-#ifndef SCM_RECKLESS
-    if (!(SCM_NUMBERP(n1)))
-    badx: SCM_WTA(SCM_ARG1, n1);
-#endif
-#ifdef SCM_BIGDIG
-  if SCM_NINUMP(n1) {
-    SCM t;
-    SCM_ASRTGO(SCM_NIMP(n1) && SCM_BIGP(n1), badx);
-    if SCM_INUMP(n2) {t = n1; n1 = n2; n2 = t; goto intbig;}
-    SCM_ASRTGO(SCM_NIMP(n2) && SCM_BIGP(n2), bady);
-    if (SCM_NUMDIGS(n1) > SCM_NUMDIGS(n2)) {t = n1; n1 = n2; n2 = t;}
-    return scm_big_test(SCM_BDIGITS(n1), SCM_NUMDIGS(n1), SCM_BIGSIGN(n1), n2);
-  }
-  if SCM_NINUMP(n2) {
-# ifndef SCM_RECKLESS
-    if (!(SCM_NIMP(n2) && SCM_BIGP(n2)))
-    bady: SCM_WTA(SCM_ARG2, n2);
-# endif
-  intbig: {
+  long int nn1;
+
+  if (SCM_INUMP (n1)) {
+    nn1 = SCM_INUM (n1);
+    if (SCM_INUMP (n2)) {
+      long nn2 = SCM_INUM (n2);
+      return SCM_BOOL (nn1 & nn2);
+    } else if (SCM_BIGP (n2)) {
+    intbig: 
+      {

 # ifndef SCM_DIGSTOOBIG
 # ifndef SCM_DIGSTOOBIG

-    long z = scm_pseudolong(SCM_INUM(n1));
-    return scm_big_test((SCM_BIGDIG *)&z, SCM_DIGSPERLONG, (n1 < 0) ? SCM_BIGSIGNFLAG : 0, n2);
+       long z = scm_pseudolong (nn1);
+       return scm_big_test ((SCM_BIGDIG *)&z, SCM_DIGSPERLONG, 
+                            (nn1 < 0) ? SCM_BIGSIGNFLAG : 0, n2);

 # else
 # else

-    SCM_BIGDIG zdigs[SCM_DIGSPERLONG];
-    scm_longdigs(SCM_INUM(n1), zdigs);
-    return scm_big_test(zdigs, SCM_DIGSPERLONG, (n1 < 0) ? SCM_BIGSIGNFLAG : 0, n2);
+       SCM_BIGDIG zdigs [SCM_DIGSPERLONG];
+       scm_longdigs (nn1, zdigs);
+       return scm_big_test (zdigs, SCM_DIGSPERLONG, 
+                            (nn1 < 0) ? SCM_BIGSIGNFLAG : 0, n2);

 # endif
 # endif

-  }}
-#else
-  SCM_ASRTGO(SCM_INUMP(n1), badx);
-  SCM_ASSERT(SCM_INUMP(n2), n2, SCM_ARG2, FUNC_NAME);
-#endif
-  return (SCM_INUM(n1) & SCM_INUM(n2)) ? SCM_BOOL_T : SCM_BOOL_F;
+      }
+    } else {
+      SCM_WRONG_TYPE_ARG (SCM_ARG2, n2);
+    }
+  } else if (SCM_BIGP (n1)) {
+    if (SCM_INUMP (n2)) {
+      SCM_SWAP (n1, n2);
+      nn1 = SCM_INUM (n1);
+      goto intbig;
+    } else if (SCM_BIGP (n2)) {
+      if (SCM_NUMDIGS (n1) > SCM_NUMDIGS (n2)) {
+       SCM_SWAP (n1, n2);
+      }
+      return scm_big_test (SCM_BDIGITS (n1), SCM_NUMDIGS (n1), 
+                          SCM_BIGSIGN (n1), n2);
+    } else {
+      SCM_WRONG_TYPE_ARG (SCM_ARG2, n2);
+    }
+  } else {
+    SCM_WRONG_TYPE_ARG (SCM_ARG1, n1);
+  }

 }
 #undef FUNC_NAME
 
 }
 #undef FUNC_NAME
 


@@ -973,34 +1036,42 @@ SCM_DEFINE (scm_logbit_p, "logbit?", 2, 0, 0,
            "@end example")
 #define FUNC_NAME s_scm_logbit_p
 {
            "@end example")
 #define FUNC_NAME s_scm_logbit_p
 {

-  SCM_ASSERT(SCM_INUMP(index) && SCM_INUM(index) >= 0, index, SCM_ARG1, FUNC_NAME);
-#ifdef SCM_BIGDIG
-  if SCM_NINUMP(j) {
-    SCM_ASSERT(SCM_NIMP(j) && SCM_BIGP(j), j, SCM_ARG2, FUNC_NAME);
-    if (SCM_NUMDIGS(j) * SCM_BITSPERDIG < SCM_INUM(index)) return SCM_BOOL_F;
-    else if SCM_BIGSIGN(j) {
+  unsigned long int iindex;
+
+  SCM_VALIDATE_INUM_MIN (SCM_ARG1, index, 0);
+  iindex = (unsigned long int) SCM_INUM (index);
+
+  if (SCM_INUMP (j)) {
+    return SCM_BOOL ((1L << iindex) & SCM_INUM (j));
+  } else if (SCM_BIGP (j)) {
+    if (SCM_NUMDIGS (j) * SCM_BITSPERDIG < iindex) {
+      return SCM_BOOL_F;
+    } else if (SCM_BIGSIGN (j)) {

       long num = -1;
       scm_sizet i = 0;
       long num = -1;
       scm_sizet i = 0;

-      SCM_BIGDIG *x = SCM_BDIGITS(j);
-      scm_sizet nx = SCM_INUM(index)/SCM_BITSPERDIG;
-      while (!0) {
+      SCM_BIGDIG * x = SCM_BDIGITS (j);
+      scm_sizet nx = iindex / SCM_BITSPERDIG;
+      while (1) {

        num += x[i];
        num += x[i];

-       if (nx==i++)
-         return ((1L << (SCM_INUM(index)%SCM_BITSPERDIG)) & num) ? SCM_BOOL_F : SCM_BOOL_T;
-       if (num < 0) num = -1;
-       else num = 0;
+       if (nx == i++) {
+         return SCM_BOOL (((1L << (iindex % SCM_BITSPERDIG)) & num) == 0);
+       } else if (num < 0) {
+         num = -1;
+       } else {
+         num = 0;
+       }

       }
       }

+    } else {
+      return SCM_BOOL (SCM_BDIGITS (j) [iindex / SCM_BITSPERDIG]
+                      & (1L << (iindex % SCM_BITSPERDIG)));

     }
     }

-    else return (SCM_BDIGITS(j)[SCM_INUM(index)/SCM_BITSPERDIG] &
-                (1L << (SCM_INUM(index)%SCM_BITSPERDIG))) ? SCM_BOOL_T : SCM_BOOL_F;
+  } else {
+    SCM_WRONG_TYPE_ARG (SCM_ARG2, j);

   }
   }

-#else
-  SCM_ASSERT(SCM_INUMP(j), j, SCM_ARG2, FUNC_NAME);
-#endif
-  return ((1L << SCM_INUM(index)) & SCM_INUM(j)) ? SCM_BOOL_T : SCM_BOOL_F;

 }
 #undef FUNC_NAME
 
 }
 #undef FUNC_NAME
 

+

 SCM_DEFINE (scm_lognot, "lognot", 1, 0, 0, 
             (SCM n),
            "Returns the integer which is the 2s-complement of the integer argument.\n\n"
 SCM_DEFINE (scm_lognot, "lognot", 1, 0, 0, 
             (SCM n),
            "Returns the integer which is the 2s-complement of the integer argument.\n\n"


@@ -1062,8 +1133,8 @@ SCM_DEFINE (scm_ash, "ash", 2, 0, 0,
             (SCM n, SCM cnt),
            "The function ash performs an arithmetic shift left by CNT bits\n"
            "(or shift right, if CNT is negative).  'Arithmetic' means, that\n"
             (SCM n, SCM cnt),
            "The function ash performs an arithmetic shift left by CNT bits\n"
            "(or shift right, if CNT is negative).  'Arithmetic' means, that\n"

-            "the function does not guarantee to keep the bit structure of N,\n"
-            "but rather guarantees that the result will always be rounded\n"
+           "the function does not guarantee to keep the bit structure of N,\n"
+           "but rather guarantees that the result will always be rounded\n"

            "towards minus infinity.  Therefore, the results of ash and a\n"
            "corresponding bitwise shift will differ if N is negative.\n\n"
            "Formally, the function returns an integer equivalent to\n"
            "towards minus infinity.  Therefore, the results of ash and a\n"
            "corresponding bitwise shift will differ if N is negative.\n\n"
            "Formally, the function returns an integer equivalent to\n"


@@ -1071,9 +1142,9 @@ SCM_DEFINE (scm_ash, "ash", 2, 0, 0,
            "Example:\n"
            "@lisp\n"
            "(number->string (ash #b1 3) 2)\n"
            "Example:\n"
            "@lisp\n"
            "(number->string (ash #b1 3) 2)\n"

-           "   @result{} \"1000\""
-           "(number->string (ash #b1010 -1) 2)"
-           "   @result{} \"101\""
+           "   @result{} \"1000\"\n"
+           "(number->string (ash #b1010 -1) 2)\n"
+           "   @result{} \"101\"\n"

            "@end lisp")
 #define FUNC_NAME s_scm_ash
 {
            "@end lisp")
 #define FUNC_NAME s_scm_ash
 {


@@ -1115,7 +1186,7 @@ SCM_DEFINE (scm_ash, "ash", 2, 0, 0,
 }
 #undef FUNC_NAME
 
 }
 #undef FUNC_NAME
 

-/* GJB:FIXME: do not use SCMs as integers! */
+

 SCM_DEFINE (scm_bit_extract, "bit-extract", 3, 0, 0,
             (SCM n, SCM start, SCM end),
            "Returns the integer composed of the @var{start} (inclusive) through\n"
 SCM_DEFINE (scm_bit_extract, "bit-extract", 3, 0, 0,
             (SCM n, SCM start, SCM end),
            "Returns the integer composed of the @var{start} (inclusive) through\n"


@@ -1130,25 +1201,57 @@ SCM_DEFINE (scm_bit_extract, "bit-extract", 3, 0, 0,
            "@end lisp")
 #define FUNC_NAME s_scm_bit_extract
 {
            "@end lisp")
 #define FUNC_NAME s_scm_bit_extract
 {

-  int istart, iend;
-  SCM_VALIDATE_INUM (1,n);
+  unsigned long int istart, iend;

   SCM_VALIDATE_INUM_MIN_COPY (2,start,0,istart);
   SCM_VALIDATE_INUM_MIN_COPY (3, end, 0, iend);
   SCM_ASSERT_RANGE (3, end, (iend >= istart));
   SCM_VALIDATE_INUM_MIN_COPY (2,start,0,istart);
   SCM_VALIDATE_INUM_MIN_COPY (3, end, 0, iend);
   SCM_ASSERT_RANGE (3, end, (iend >= istart));

-#ifdef SCM_BIGDIG
-  if (SCM_NINUMP (n))
-    return
-      scm_logand (scm_difference (scm_integer_expt (SCM_MAKINUM (2),
-                                                   SCM_MAKINUM (iend - istart)),
-                                 SCM_MAKINUM (1L)),
-                 scm_ash (n, SCM_MAKINUM (-istart)));
-#else
-  SCM_VALIDATE_INUM (1,n);
-#endif
-  return SCM_MAKINUM ((SCM_INUM (n) >> istart) & ((1L << (iend - istart)) - 1));
+
+  if (SCM_INUMP (n)) {
+    long int in = SCM_INUM (n);
+    unsigned long int bits = iend - istart;
+
+    if (in < 0 && bits >= SCM_FIXNUM_BIT)
+      {
+       /* Since we emulate two's complement encoded numbers, this special
+        * case requires us to produce a result that has more bits than can be
+        * stored in a fixnum.  Thus, we fall back to the more general
+        * algorithm that is used for bignums.  
+        */
+       goto generalcase;
+      }
+
+    if (istart < SCM_FIXNUM_BIT)
+      {
+       in = in >> istart;
+       if (bits < SCM_FIXNUM_BIT)
+         return SCM_MAKINUM (in & ((1L << bits) - 1));
+       else /* we know: in >= 0 */
+         return SCM_MAKINUM (in);
+      }
+    else if (in < 0)
+      {
+       return SCM_MAKINUM (-1L & ((1L << bits) - 1));
+      }
+    else
+      {
+       return SCM_MAKINUM (0);
+      }
+  } else if (SCM_BIGP (n)) {
+  generalcase:
+    {
+      SCM num1 = SCM_MAKINUM (1L);
+      SCM num2 = SCM_MAKINUM (2L);
+      SCM bits = SCM_MAKINUM (iend - istart);
+      SCM mask  = scm_difference (scm_integer_expt (num2, bits), num1);
+      return scm_logand (mask, scm_ash (n, SCM_MAKINUM (-istart)));
+    }
+  } else {
+    SCM_WRONG_TYPE_ARG (SCM_ARG1, n);
+  }

 }
 #undef FUNC_NAME
 
 }
 #undef FUNC_NAME
 

+

 static const char scm_logtab[] = {
   0, 1, 1, 2, 1, 2, 2, 3, 1, 2, 2, 3, 2, 3, 3, 4
 };
 static const char scm_logtab[] = {
   0, 1, 1, 2, 1, 2, 2, 3, 1, 2, 2, 3, 2, 3, 3, 4
 };


@@ -1170,30 +1273,35 @@ SCM_DEFINE (scm_logcount, "logcount", 1, 0, 0,
            "@end lisp")
 #define FUNC_NAME s_scm_logcount
 {
            "@end lisp")
 #define FUNC_NAME s_scm_logcount
 {

-  register unsigned long c = 0;
-  register long nn;
-#ifdef SCM_BIGDIG
-  if (SCM_NINUMP (n))
-    {
-      scm_sizet i;
-      SCM_BIGDIG *ds, d;
-      SCM_VALIDATE_BIGINT (1,n);
-      if (SCM_BIGSIGN (n))
-       return scm_logcount (scm_difference (SCM_MAKINUM (-1L), n));
-      ds = SCM_BDIGITS (n);
-      for (i = SCM_NUMDIGS (n); i--;)
-       for (d = ds[i]; d; d >>= 4)
+  if (SCM_INUMP (n)) {
+    unsigned long int c = 0;
+    long int nn = SCM_INUM (n);
+    if (nn < 0) {
+      nn = -1 - nn;
+    };
+    while (nn) {
+      c += scm_logtab[15 & nn];
+      nn >>= 4;
+    };
+    return SCM_MAKINUM (c);
+  } else if (SCM_BIGP (n)) {
+    if (SCM_BIGSIGN (n)) {
+      return scm_logcount (scm_difference (SCM_MAKINUM (-1L), n));
+    } else {
+      unsigned long int c = 0;
+      scm_sizet i = SCM_NUMDIGS (n);
+      SCM_BIGDIG * ds = SCM_BDIGITS (n);
+      while (i--) {
+       SCM_BIGDIG d;
+       for (d = ds[i]; d; d >>= 4) {

          c += scm_logtab[15 & d];
          c += scm_logtab[15 & d];

+       }
+      }

       return SCM_MAKINUM (c);
     }
       return SCM_MAKINUM (c);
     }

-#else
-  SCM_VALIDATE_INUM (1,n);
-#endif
-  if ((nn = SCM_INUM (n)) < 0)
-    nn = -1 - nn;
-  for (; nn; nn >>= 4)
-    c += scm_logtab[15 & nn];
-  return SCM_MAKINUM (c);
+  } else {
+    SCM_WRONG_TYPE_ARG (SCM_ARG1, n);
+  }

 }
 #undef FUNC_NAME
 
 }
 #undef FUNC_NAME
 


@@ -1216,36 +1324,38 @@ SCM_DEFINE (scm_integer_length, "integer-length", 1, 0, 0,
            "@end lisp")
 #define FUNC_NAME s_scm_integer_length
 {
            "@end lisp")
 #define FUNC_NAME s_scm_integer_length
 {

-  register unsigned long c = 0;
-  register long nn;
-  unsigned int l = 4;
-#ifdef SCM_BIGDIG
-  if (SCM_NINUMP (n))
-    {
-      SCM_BIGDIG *ds, d;
-      SCM_VALIDATE_BIGINT (1,n);
-      if (SCM_BIGSIGN (n))
-       return scm_integer_length (scm_difference (SCM_MAKINUM (-1L), n));
-      ds = SCM_BDIGITS (n);
-      d = ds[c = SCM_NUMDIGS (n) - 1];
-      for (c *= SCM_BITSPERDIG; d; d >>= 4)
-       {
-         c += 4;
-         l = scm_ilentab[15 & d];
-       }
-      return SCM_MAKINUM (c - 4 + l);
-    }
-#else
-  SCM_VALIDATE_INUM (1,n);
-#endif
-  if ((nn = SCM_INUM (n)) < 0)
-    nn = -1 - nn;
-  for (; nn; nn >>= 4)
-    {
+  if (SCM_INUMP (n)) {
+    unsigned long int c = 0;
+    unsigned int l = 4;
+    long int nn = SCM_INUM (n);
+    if (nn < 0) {
+      nn = -1 - nn;
+    };
+    while (nn) {

       c += 4;
       c += 4;

-      l = scm_ilentab[15 & nn];
+      l = scm_ilentab [15 & nn];
+      nn >>= 4;
+    };
+    return SCM_MAKINUM (c - 4 + l);
+  } else if (SCM_BIGP (n)) {
+    if (SCM_BIGSIGN (n)) {
+      return scm_integer_length (scm_difference (SCM_MAKINUM (-1L), n));
+    } else {
+      unsigned long int digs = SCM_NUMDIGS (n) - 1;
+      unsigned long int c = digs * SCM_BITSPERDIG;
+      unsigned int l = 4;
+      SCM_BIGDIG * ds = SCM_BDIGITS (n);
+      SCM_BIGDIG d = ds [digs];
+      while (d) {
+       c += 4;
+       l = scm_ilentab [15 & d];
+       d >>= 4;
+      };
+      return SCM_MAKINUM (c - 4 + l);

     }
     }

-  return SCM_MAKINUM (c - 4 + l);
+  } else {
+    SCM_WRONG_TYPE_ARG (SCM_ARG1, n);
+  }

 }
 #undef FUNC_NAME
 
 }
 #undef FUNC_NAME
 


@@ -1260,12 +1370,11 @@ scm_mkbig (scm_sizet nlen, int sign)
   /* Cast to long int to avoid signed/unsigned comparison warnings.  */
   if ((( ((long int) nlen) << SCM_BIGSIZEFIELD) >> SCM_BIGSIZEFIELD)
       != (long int) nlen)
   /* Cast to long int to avoid signed/unsigned comparison warnings.  */
   if ((( ((long int) nlen) << SCM_BIGSIZEFIELD) >> SCM_BIGSIZEFIELD)
       != (long int) nlen)

-    scm_wta (SCM_MAKINUM (nlen), (char *) SCM_NALLOC, s_bignum);
+    scm_memory_error (s_bignum);

   
   SCM_NEWCELL (v);
   SCM_DEFER_INTS;
   
   SCM_NEWCELL (v);
   SCM_DEFER_INTS;

-  SCM_SETCHARS (v, scm_must_malloc ((long) (nlen * sizeof (SCM_BIGDIG)),
-                                   s_bignum));
+  SCM_SET_BIGNUM_BASE (v, scm_must_malloc (nlen * sizeof (SCM_BIGDIG), s_bignum));

   SCM_SETNUMDIGS (v, nlen, sign);
   SCM_ALLOW_INTS;
   return v;
   SCM_SETNUMDIGS (v, nlen, sign);
   SCM_ALLOW_INTS;
   return v;


@@ -1284,7 +1393,7 @@ scm_big2inum (SCM b, scm_sizet l)
       if (SCM_POSFIXABLE (num))
        return SCM_MAKINUM (num);
     }
       if (SCM_POSFIXABLE (num))
        return SCM_MAKINUM (num);
     }

-  else if (SCM_UNEGFIXABLE (num))
+  else if (num <= -SCM_MOST_NEGATIVE_FIXNUM)

     return SCM_MAKINUM (-num);
   return b;
 }
     return SCM_MAKINUM (-num);
   return b;
 }


@@ -1297,17 +1406,17 @@ scm_adjbig (SCM b, scm_sizet nlen)
 {
   scm_sizet nsiz = nlen;
   if (((nsiz << SCM_BIGSIZEFIELD) >> SCM_BIGSIZEFIELD) != nlen)
 {
   scm_sizet nsiz = nlen;
   if (((nsiz << SCM_BIGSIZEFIELD) >> SCM_BIGSIZEFIELD) != nlen)

-    scm_wta (scm_ulong2num (nsiz), (char *) SCM_NALLOC, s_adjbig);
+    scm_memory_error (s_adjbig);

 
   SCM_DEFER_INTS;
   {
     SCM_BIGDIG *digits
       = ((SCM_BIGDIG *)
 
   SCM_DEFER_INTS;
   {
     SCM_BIGDIG *digits
       = ((SCM_BIGDIG *)

-        scm_must_realloc ((char *) SCM_CHARS (b),
+        scm_must_realloc ((char *) SCM_BDIGITS (b),

                           (long) (SCM_NUMDIGS (b) * sizeof (SCM_BIGDIG)),
                           (long) (nsiz * sizeof (SCM_BIGDIG)), s_bignum));
 
                           (long) (SCM_NUMDIGS (b) * sizeof (SCM_BIGDIG)),
                           (long) (nsiz * sizeof (SCM_BIGDIG)), s_bignum));
 

-    SCM_SETCHARS (b, digits);
+    SCM_SET_BIGNUM_BASE (b, digits);

     SCM_SETNUMDIGS (b, nsiz, SCM_BIGSIGN (b));
   }
   SCM_ALLOW_INTS;
     SCM_SETNUMDIGS (b, nsiz, SCM_BIGSIGN (b));
   }
   SCM_ALLOW_INTS;


@@ -1405,7 +1514,7 @@ scm_long_long2big (long_long n)
     }
   return ans;
 }
     }
   return ans;
 }

-#endif
+#endif /* HAVE_LONG_LONGS */

 
 
 SCM
 
 
 SCM


@@ -1652,16 +1761,8 @@ scm_mulbig (SCM_BIGDIG *x, scm_sizet nx, SCM_BIGDIG *y, scm_sizet ny, int sgn)
 }
 
 
 }
 
 

-/* Sun's compiler complains about the fact that this function has an
-   ANSI prototype in numbers.h, but a K&R declaration here, and the
-   two specify different promotions for the third argument.  I'm going
-   to turn this into an ANSI declaration, and see if anyone complains
-   about it not being K&R.  */
-

 unsigned int
 unsigned int

-scm_divbigdig (SCM_BIGDIG * ds,
-              scm_sizet h,
-              SCM_BIGDIG div)
+scm_divbigdig (SCM_BIGDIG * ds, scm_sizet h, SCM_BIGDIG div)

 {
   register unsigned long t2 = 0;
   while (h--)
 {
   register unsigned long t2 = 0;
   while (h--)


@@ -1675,7 +1776,7 @@ scm_divbigdig (SCM_BIGDIG * ds,
 
 
 
 
 
 

-SCM
+static SCM

 scm_divbigint (SCM x, long z, int sgn, int mode)
 {
   if (z < 0)
 scm_divbigint (SCM x, long z, int sgn, int mode)
 {
   if (z < 0)


@@ -1708,14 +1809,14 @@ scm_divbigint (SCM x, long z, int sgn, int mode)
 }
 
 
 }
 
 

-SCM
+static SCM

 scm_divbigbig (SCM_BIGDIG *x, scm_sizet nx, SCM_BIGDIG *y, scm_sizet ny, int sgn, int modes)
 {
   /* modes description
      0  remainder
      1  scm_modulo
      2  quotient
 scm_divbigbig (SCM_BIGDIG *x, scm_sizet nx, SCM_BIGDIG *y, scm_sizet ny, int sgn, int modes)
 {
   /* modes description
      0  remainder
      1  scm_modulo
      2  quotient

-     3  quotient but returns 0 if division is not exact. */
+     3  quotient but returns SCM_UNDEFINED if division is not exact. */

   scm_sizet i = 0, j = 0;
   long num = 0;
   unsigned long t2 = 0;
   scm_sizet i = 0, j = 0;
   long num = 0;
   unsigned long t2 = 0;


@@ -1770,7 +1871,7 @@ scm_divbigbig (SCM_BIGDIG *x, scm_sizet nx, SCM_BIGDIG *y, scm_sizet ny, int sgn
       case 2:
        return SCM_INUM0;       /* quotient is zero */
       case 3:
       case 2:
        return SCM_INUM0;       /* quotient is zero */
       case 3:

-       return 0;               /* the division is not exact */
+       return SCM_UNDEFINED;   /* the division is not exact */

       }
 
   z = scm_mkbig (nx == ny ? nx + 2 : nx + 1, sgn);
       }
 
   z = scm_mkbig (nx == ny ? nx + 2 : nx + 1, sgn);


@@ -1860,7 +1961,7 @@ scm_divbigbig (SCM_BIGDIG *x, scm_sizet nx, SCM_BIGDIG *y, scm_sizet ny, int sgn
     case 3:                    /* check that remainder==0 */
       for (j = ny; j && !zds[j - 1]; --j);
       if (j)
     case 3:                    /* check that remainder==0 */
       for (j = ny; j && !zds[j - 1]; --j);
       if (j)

-       return 0;
+       return SCM_UNDEFINED;

     case 2:                    /* move quotient down in z */
       j = (nx == ny ? nx + 2 : nx + 1) - ny;
       for (i = 0; i < j; i++)
     case 2:                    /* move quotient down in z */
       j = (nx == ny ? nx + 2 : nx + 1) - ny;
       for (i = 0; i < j; i++)


@@ -2124,16 +2225,14 @@ big2str (SCM b, unsigned int radix)
     : (SCM_BITSPERDIG * i) + 2;
   scm_sizet k = 0;
   scm_sizet radct = 0;
     : (SCM_BITSPERDIG * i) + 2;
   scm_sizet k = 0;
   scm_sizet radct = 0;

-  scm_sizet ch;                        /* jeh */

   SCM_BIGDIG radpow = 1, radmod = 0;
   SCM ss = scm_makstr ((long) j, 0);
   SCM_BIGDIG radpow = 1, radmod = 0;
   SCM ss = scm_makstr ((long) j, 0);

-  char *s = SCM_CHARS (ss), c;
+  char *s = SCM_STRING_CHARS (ss), c;

   while ((long) radpow * radix < SCM_BIGRAD)
     {
       radpow *= radix;
       radct++;
     }
   while ((long) radpow * radix < SCM_BIGRAD)
     {
       radpow *= radix;
       radct++;
     }

-  s[0] = SCM_BIGSIGN (b) ? '-' : '+';

   while ((i || radmod) && j)
     {
       if (k == 0)
   while ((i || radmod) && j)
     {
       if (k == 0)


@@ -2148,13 +2247,15 @@ big2str (SCM b, unsigned int radix)
       k--;
       s[--j] = c < 10 ? c + '0' : c + 'a' - 10;
     }
       k--;
       s[--j] = c < 10 ? c + '0' : c + 'a' - 10;
     }

-  ch = s[0] == '-' ? 1 : 0;    /* jeh */
-  if (ch < j)
-    {                          /* jeh */
-      for (i = j; j < SCM_LENGTH (ss); j++)
-       s[ch + j - i] = s[j];   /* jeh */
-      scm_vector_set_length_x (ss, /* jeh */
-                              SCM_MAKINUM (ch + SCM_LENGTH (ss) - i));
+
+  if (SCM_BIGSIGN (b))
+    s[--j] = '-';
+
+  if (j > 0)
+    {
+      /* The pre-reserved string length was too large. */
+      unsigned long int length = SCM_STRING_LENGTH (ss);
+      ss = scm_substring (ss, SCM_MAKINUM (j), SCM_MAKINUM (length));

     }
 
   return scm_return_first (ss, t);
     }
 
   return scm_return_first (ss, t);


@@ -2163,39 +2264,33 @@ big2str (SCM b, unsigned int radix)
 
 
 SCM_DEFINE (scm_number_to_string, "number->string", 1, 1, 0,
 
 
 SCM_DEFINE (scm_number_to_string, "number->string", 1, 1, 0,

-            (SCM x, SCM radix),
-           "")
+            (SCM n, SCM radix),
+           "Return a string holding the external representation of the\n"
+           "number N in the given RADIX.  If N is inexact, a radix of 10\n"
+           "will be used.")

 #define FUNC_NAME s_scm_number_to_string
 {
   int base;
 #define FUNC_NAME s_scm_number_to_string
 {
   int base;

-  SCM_VALIDATE_INUM_MIN_DEF_COPY (2,radix,2,10,base);
-  if (SCM_NINUMP (x))
-    {
-      char num_buf[SCM_FLOBUFLEN];
-#ifdef SCM_BIGDIG
-      SCM_ASRTGO (SCM_NIMP (x), badx);
-      if (SCM_BIGP (x))
-       return big2str (x, (unsigned int) base);
-#ifndef SCM_RECKLESS
-      if (!SCM_SLOPPY_INEXACTP (x))
-       {
-       badx:
-         SCM_WTA (1, x);
-       }
-#endif
-#else
-      SCM_ASSERT (SCM_SLOPPY_INEXACTP (x),
-                 x, SCM_ARG1, s_number_to_string);
-#endif
-      return scm_makfromstr (num_buf, iflo2str (x, num_buf), 0);
-    }
-  {
-    char num_buf[SCM_INTBUFLEN];
-    return scm_makfromstr (num_buf,
-                          scm_iint2str (SCM_INUM (x),
-                                        base,
-                                        num_buf),
-                          0);
+
+  if (SCM_UNBNDP (radix)) {
+    base = 10;
+  } else {
+    SCM_VALIDATE_INUM (2, radix);
+    base = SCM_INUM (radix);
+    SCM_ASSERT_RANGE (2, radix, base >= 2);
+  }
+
+  if (SCM_INUMP (n)) {
+    char num_buf [SCM_INTBUFLEN];
+    scm_sizet length = scm_iint2str (SCM_INUM (n), base, num_buf);
+    return scm_makfromstr (num_buf, length, 0);
+  } else if (SCM_BIGP (n)) {
+    return big2str (n, (unsigned int) base);
+  } else if (SCM_INEXACTP (n)) {
+    char num_buf [SCM_FLOBUFLEN];
+    return scm_makfromstr (num_buf, iflo2str (n, num_buf), 0);
+  } else {
+    SCM_WRONG_TYPE_ARG (1, n);

   }
 }
 #undef FUNC_NAME
   }
 }
 #undef FUNC_NAME


@@ -2225,7 +2320,7 @@ scm_bigprint (SCM exp, SCM port, scm_print_state *pstate)
 {
 #ifdef SCM_BIGDIG
   exp = big2str (exp, (unsigned int) 10);
 {
 #ifdef SCM_BIGDIG
   exp = big2str (exp, (unsigned int) 10);

-  scm_lfwrite (SCM_CHARS (exp), (scm_sizet) SCM_LENGTH (exp), port);
+  scm_lfwrite (SCM_STRING_CHARS (exp), (scm_sizet) SCM_STRING_LENGTH (exp), port);

 #else
   scm_ipruk ("bignum", exp, port);
 #endif
 #else
   scm_ipruk ("bignum", exp, port);
 #endif


@@ -2426,7 +2521,7 @@ scm_istr2flo (char *str, long len, long radix)
        return SCM_BOOL_F;      /* must have leading sign */
       if (++i < len)
        return SCM_BOOL_F;      /* `i' not last character */
        return SCM_BOOL_F;      /* must have leading sign */
       if (++i < len)
        return SCM_BOOL_F;      /* `i' not last character */

-      return scm_makdbl (0.0, lead_sgn);
+      return scm_make_complex (0.0, lead_sgn);

     }
   do
     {                          /* check initial digits */
     }
   do
     {                          /* check initial digits */


@@ -2595,7 +2690,7 @@ scm_istr2flo (char *str, long len, long radix)
              case DIGITS:
                expon = expon * 10 + c - '0';
                if (expon > SCM_MAXEXP)
              case DIGITS:
                expon = expon * 10 + c - '0';
                if (expon > SCM_MAXEXP)

-                 return SCM_BOOL_F;    /* exponent too large */
+                 scm_out_of_range ("string->number", SCM_MAKINUM (expon));

                break;
              default:
                goto out4;
                break;
              default:
                goto out4;


@@ -2625,7 +2720,7 @@ scm_istr2flo (char *str, long len, long radix)
   if (lead_sgn == -1.0)
     res = -res;
   if (i == len)
   if (lead_sgn == -1.0)
     res = -res;
   if (i == len)

-    return scm_makdbl (res, 0.0);
+    return scm_make_real (res);

 
   if (str[i] == 'i' || str[i] == 'I')
     {                          /* pure imaginary number  */
 
   if (str[i] == 'i' || str[i] == 'I')
     {                          /* pure imaginary number  */


@@ -2633,7 +2728,7 @@ scm_istr2flo (char *str, long len, long radix)
        return SCM_BOOL_F;      /* must have leading sign */
       if (++i < len)
        return SCM_BOOL_F;      /* `i' not last character */
        return SCM_BOOL_F;      /* must have leading sign */
       if (++i < len)
        return SCM_BOOL_F;      /* `i' not last character */

-      return scm_makdbl (0.0, res);
+      return scm_make_complex (0.0, res);

     }
 
   switch (str[i++])
     }
 
   switch (str[i++])


@@ -2652,8 +2747,8 @@ scm_istr2flo (char *str, long len, long radix)
          return SCM_BOOL_F;    /* not `real' */
        if (SCM_SLOPPY_COMPLEXP (second))
          return SCM_BOOL_F;    /* not `real' */
          return SCM_BOOL_F;    /* not `real' */
        if (SCM_SLOPPY_COMPLEXP (second))
          return SCM_BOOL_F;    /* not `real' */

-       tmp = SCM_REALPART (second);
-       return scm_makdbl (res * cos (tmp), res * sin (tmp));
+       tmp = SCM_REAL_VALUE (second);
+       return scm_make_complex (res * cos (tmp), res * sin (tmp));

       }
     default:
       return SCM_BOOL_F;
       }
     default:
       return SCM_BOOL_F;


@@ -2664,17 +2759,17 @@ scm_istr2flo (char *str, long len, long radix)
     return SCM_BOOL_F;
   /* handles `x+i' and `x-i' */
   if (i == (len - 1))
     return SCM_BOOL_F;
   /* handles `x+i' and `x-i' */
   if (i == (len - 1))

-    return scm_makdbl (res, lead_sgn);
+    return scm_make_complex (res, lead_sgn);

   /* get a `ureal' for complex part */
   second = scm_istr2flo (&str[i], (long) ((len - i) - 1), radix);
   if (!SCM_INEXACTP (second))
     return SCM_BOOL_F;         /* not `ureal' */
   if (SCM_SLOPPY_COMPLEXP (second))
     return SCM_BOOL_F;         /* not `ureal' */
   /* get a `ureal' for complex part */
   second = scm_istr2flo (&str[i], (long) ((len - i) - 1), radix);
   if (!SCM_INEXACTP (second))
     return SCM_BOOL_F;         /* not `ureal' */
   if (SCM_SLOPPY_COMPLEXP (second))
     return SCM_BOOL_F;         /* not `ureal' */

-  tmp = SCM_REALPART (second);
+  tmp = SCM_REAL_VALUE (second);

   if (tmp < 0.0)
     return SCM_BOOL_F;         /* not `ureal' */
   if (tmp < 0.0)
     return SCM_BOOL_F;         /* not `ureal' */

-  return scm_makdbl (res, (lead_sgn * tmp));
+  return scm_make_complex (res, (lead_sgn * tmp));

 }
 
 
 }
 
 


@@ -2749,38 +2844,55 @@ scm_istring2number (char *str, long len, long radix)
 
 
 SCM_DEFINE (scm_string_to_number, "string->number", 1, 1, 0,
 
 
 SCM_DEFINE (scm_string_to_number, "string->number", 1, 1, 0,

-            (SCM str, SCM radix),
-           "")
+            (SCM string, SCM radix),
+           "Returns a number of the maximally precise representation\n"
+           "expressed by the given STRING. RADIX must be an exact integer,\n"
+           "either 2, 8, 10, or 16. If supplied, RADIX is a default radix\n"
+           "that may be overridden by an explicit radix prefix in STRING\n"
+           "(e.g. \"#o177\"). If RADIX is not supplied, then the default\n"
+           "radix is 10. If string is not a syntactically valid notation\n"
+           "for a number, then `string->number' returns #f.  (r5rs)") 

 #define FUNC_NAME s_scm_string_to_number
 {
   SCM answer;
   int base;
 #define FUNC_NAME s_scm_string_to_number
 {
   SCM answer;
   int base;

-  SCM_VALIDATE_ROSTRING (1,str);
+  SCM_VALIDATE_STRING (1, string);

   SCM_VALIDATE_INUM_MIN_DEF_COPY (2,radix,2,10,base);
   SCM_VALIDATE_INUM_MIN_DEF_COPY (2,radix,2,10,base);

-  answer = scm_istring2number (SCM_ROCHARS (str),
-                              SCM_ROLENGTH (str),
+  answer = scm_istring2number (SCM_STRING_CHARS (string),
+                              SCM_STRING_LENGTH (string),

                                base);
                                base);

-  return scm_return_first (answer, str);
+  return scm_return_first (answer, string);

 }
 #undef FUNC_NAME
 /*** END strs->nums ***/
 
 }
 #undef FUNC_NAME
 /*** END strs->nums ***/
 

+

 SCM
 scm_make_real (double x)
 {
   SCM z;
 SCM
 scm_make_real (double x)
 {
   SCM z;

-  SCM_NEWREAL (z, x);
+  SCM_NEWCELL2 (z);
+  SCM_SET_CELL_TYPE (z, scm_tc16_real);
+  SCM_REAL_VALUE (z) = x;

   return z;
 }
 
   return z;
 }
 

+

 SCM
 scm_make_complex (double x, double y)
 {
 SCM
 scm_make_complex (double x, double y)
 {

-  SCM z;
-  SCM_NEWCOMPLEX (z, x, y);
-  return z;
+  if (y == 0.0) {
+    return scm_make_real (x);
+  } else {
+    SCM z;
+    SCM_NEWSMOB (z, scm_tc16_complex, scm_must_malloc (2L * sizeof (double), "complex"));
+    SCM_COMPLEX_REAL (z) = x;
+    SCM_COMPLEX_IMAG (z) = y;
+    return z;
+  }

 }
 
 }
 

+

 SCM
 scm_bigequal (SCM x, SCM y)
 {
 SCM
 scm_bigequal (SCM x, SCM y)
 {


@@ -2810,46 +2922,45 @@ SCM_REGISTER_PROC (s_number_p, "number?", 1, 0, 0, scm_number_p);
 
 SCM_DEFINE (scm_number_p, "complex?", 1, 0, 0, 
             (SCM x),
 
 SCM_DEFINE (scm_number_p, "complex?", 1, 0, 0, 
             (SCM x),

-           "")
+           "Return #t if X is a complex number, #f else.  Note that the\n"
+           "sets of real, rational and integer values form subsets of the\n"
+           "set of complex numbers, i. e. the predicate will also be\n"
+           "fulfilled if X is a real, rational or integer number.")

 #define FUNC_NAME s_scm_number_p
 {
 #define FUNC_NAME s_scm_number_p
 {

-  if (SCM_INUMP (x))
-    return SCM_BOOL_T;
-  if (SCM_NUMP (x))
-    return SCM_BOOL_T;
-  return SCM_BOOL_F;
+  return SCM_BOOL (SCM_NUMBERP (x));

 }
 #undef FUNC_NAME
 
 
 }
 #undef FUNC_NAME
 
 

-

 SCM_REGISTER_PROC (s_real_p, "real?", 1, 0, 0, scm_real_p);
 
 SCM_REGISTER_PROC (s_real_p, "real?", 1, 0, 0, scm_real_p);
 

-

 SCM_DEFINE (scm_real_p, "rational?", 1, 0, 0, 
             (SCM x),
 SCM_DEFINE (scm_real_p, "rational?", 1, 0, 0, 
             (SCM x),

-           "")
+           "Return #t if X is a rational number, #f else.  Note that the\n"
+           "set of integer values forms a subset of the set of rational\n"
+           "numbers, i. e. the predicate will also be fulfilled if X is an\n"
+           "integer number.")

 #define FUNC_NAME s_scm_real_p
 {
 #define FUNC_NAME s_scm_real_p
 {

-  if (SCM_INUMP (x))
+  if (SCM_INUMP (x)) {

     return SCM_BOOL_T;
     return SCM_BOOL_T;

-  if (SCM_IMP (x))
+  } else if (SCM_IMP (x)) {

     return SCM_BOOL_F;
     return SCM_BOOL_F;

-  if (SCM_SLOPPY_REALP (x))
+  } else if (SCM_SLOPPY_REALP (x)) {

     return SCM_BOOL_T;
     return SCM_BOOL_T;

-#ifdef SCM_BIGDIG
-  if (SCM_BIGP (x))
+  } else if (SCM_BIGP (x)) {

     return SCM_BOOL_T;
     return SCM_BOOL_T;

-#endif
-  return SCM_BOOL_F;
+  } else {
+    return SCM_BOOL_F;
+  }

 }
 #undef FUNC_NAME
 
 
 }
 #undef FUNC_NAME
 
 

-

 SCM_DEFINE (scm_integer_p, "integer?", 1, 0, 0, 
             (SCM x),
 SCM_DEFINE (scm_integer_p, "integer?", 1, 0, 0, 
             (SCM x),

-           "")
+           "Return #t if X is an integer number, #f else.")

 #define FUNC_NAME s_scm_integer_p
 {
   double r;
 #define FUNC_NAME s_scm_integer_p
 {
   double r;


@@ -2857,15 +2968,13 @@ SCM_DEFINE (scm_integer_p, "integer?", 1, 0, 0,
     return SCM_BOOL_T;
   if (SCM_IMP (x))
     return SCM_BOOL_F;
     return SCM_BOOL_T;
   if (SCM_IMP (x))
     return SCM_BOOL_F;

-#ifdef SCM_BIGDIG

   if (SCM_BIGP (x))
     return SCM_BOOL_T;
   if (SCM_BIGP (x))
     return SCM_BOOL_T;

-#endif

   if (!SCM_SLOPPY_INEXACTP (x))
     return SCM_BOOL_F;
   if (SCM_SLOPPY_COMPLEXP (x))
     return SCM_BOOL_F;
   if (!SCM_SLOPPY_INEXACTP (x))
     return SCM_BOOL_F;
   if (SCM_SLOPPY_COMPLEXP (x))
     return SCM_BOOL_F;

-  r = SCM_REALPART (x);
+  r = SCM_REAL_VALUE (x);

   if (r == floor (r))
     return SCM_BOOL_T;
   return SCM_BOOL_F;
   if (r == floor (r))
     return SCM_BOOL_T;
   return SCM_BOOL_F;


@@ -2873,305 +2982,232 @@ SCM_DEFINE (scm_integer_p, "integer?", 1, 0, 0,
 #undef FUNC_NAME
 
 
 #undef FUNC_NAME
 
 

-

 SCM_DEFINE (scm_inexact_p, "inexact?", 1, 0, 0, 
             (SCM x),
 SCM_DEFINE (scm_inexact_p, "inexact?", 1, 0, 0, 
             (SCM x),

-           "")
+           "Return #t if X is an inexact number, #f else.")

 #define FUNC_NAME s_scm_inexact_p
 {
 #define FUNC_NAME s_scm_inexact_p
 {

-  if (SCM_INEXACTP (x))
-    return SCM_BOOL_T;
-  return SCM_BOOL_F;
+  return SCM_BOOL (SCM_INEXACTP (x));

 }
 #undef FUNC_NAME
 
 
 }
 #undef FUNC_NAME
 
 

-
-

 SCM_GPROC1 (s_eq_p, "=", scm_tc7_rpsubr, scm_num_eq_p, g_eq_p);
 
 SCM
 scm_num_eq_p (SCM x, SCM y)
 {
 SCM_GPROC1 (s_eq_p, "=", scm_tc7_rpsubr, scm_num_eq_p, g_eq_p);
 
 SCM
 scm_num_eq_p (SCM x, SCM y)
 {

-  SCM t;
-  if (SCM_NINUMP (x))
-    {
-#ifdef SCM_BIGDIG
-      if (!SCM_NIMP (x))
-       {
-       badx:
-         SCM_WTA_DISPATCH_2 (g_eq_p, x, y, SCM_ARG1, s_eq_p);
-       }
-      if (SCM_BIGP (x))
-       {
-         if (SCM_INUMP (y))
-           return SCM_BOOL_F;
-         SCM_ASRTGO (SCM_NIMP (y), bady);
-         if (SCM_BIGP (y))
-           return SCM_BOOL(0 == scm_bigcomp (x, y));
-         SCM_ASRTGO (SCM_SLOPPY_INEXACTP (y), bady);
-       bigreal:
-         return ((SCM_SLOPPY_REALP (y) && (scm_big2dbl (x) == SCM_REALPART (y)))
-                 ? SCM_BOOL_T
-                 : SCM_BOOL_F);
-       }
-      SCM_ASRTGO (SCM_SLOPPY_INEXACTP (x), badx);
-#else
-      SCM_GASSERT2 (SCM_SLOPPY_INEXACTP (x),
-                   g_eq_p, x, y, SCM_ARG1, s_eq_p);
-#endif
-      if (SCM_INUMP (y))
-       {
-         t = x;
-         x = y;
-         y = t;
-         goto realint;
-       }
-#ifdef SCM_BIGDIG
-      SCM_ASRTGO (SCM_NIMP (y), bady);
-      if (SCM_BIGP (y))
-       {
-         t = x;
-         x = y;
-         y = t;
-         goto bigreal;
-       }
-      SCM_ASRTGO (SCM_SLOPPY_INEXACTP (y), bady);
-#else
-      SCM_ASRTGO (SCM_SLOPPY_INEXACTP (y), bady);
-#endif
-      if (SCM_SLOPPY_REALP (x))
-       {
-         if (SCM_SLOPPY_REALP (y))
-           return SCM_BOOL (SCM_REAL_VALUE (x) == SCM_REAL_VALUE (y));
-         else
-           return SCM_BOOL (SCM_REAL_VALUE (x) == SCM_COMPLEX_REAL (y)
-                            && 0.0 == SCM_COMPLEX_IMAG (y));
-       }
-      else
-       {
-         if (SCM_SLOPPY_REALP (y))
-           return SCM_BOOL (SCM_COMPLEX_REAL (x) == SCM_REAL_VALUE (y)
-                            && SCM_COMPLEX_IMAG (x) == 0.0);
-         else
-           return SCM_BOOL (SCM_COMPLEX_REAL (x) == SCM_COMPLEX_REAL (y)
-                            && SCM_COMPLEX_IMAG (x) == SCM_COMPLEX_IMAG (y));
-       }
+  if (SCM_INUMP (x)) {
+    long xx = SCM_INUM (x);
+    if (SCM_INUMP (y)) {
+      long yy = SCM_INUM (y);
+      return SCM_BOOL (xx == yy);
+    } else if (SCM_BIGP (y)) {
+      return SCM_BOOL_F;
+    } else if (SCM_REALP (y)) {
+      return SCM_BOOL ((double) xx == SCM_REAL_VALUE (y));
+    } else if (SCM_COMPLEXP (y)) {
+      return SCM_BOOL (((double) xx == SCM_COMPLEX_REAL (y))
+                      && (0.0 == SCM_COMPLEX_IMAG (y)));
+    } else {
+      SCM_WTA_DISPATCH_2 (g_eq_p, x, y, SCM_ARGn, s_eq_p);

     }
     }

-  if (SCM_NINUMP (y))
-    {
-#ifdef SCM_BIGDIG
-      SCM_ASRTGO (SCM_NIMP (y), bady);
-      if (SCM_BIGP (y))
-       return SCM_BOOL_F;
-      if (!SCM_SLOPPY_INEXACTP (y))
-       {
-       bady:
-         SCM_WTA_DISPATCH_2 (g_eq_p, x, y, SCM_ARGn, s_eq_p);
-       }
-#else
-      if (!SCM_SLOPPY_INEXACTP (y))
-       {
-       bady:
-         SCM_WTA_DISPATCH_2 (g_eq_p, x, y, SCM_ARGn, s_eq_p);
-       }
-#endif
-    realint:
-      if (SCM_SLOPPY_REALP (y))
-       return SCM_BOOL ((double) SCM_INUM (x) == SCM_REAL_VALUE (y));
-      else
-       return SCM_BOOL ((double) SCM_INUM (x) == SCM_COMPLEX_REAL (y)
-                        && 0.0 == SCM_COMPLEX_IMAG (y));
+  } else if (SCM_BIGP (x)) {
+    if (SCM_INUMP (y)) {
+      return SCM_BOOL_F;
+    } else if (SCM_BIGP (y)) {
+      return SCM_BOOL (0 == scm_bigcomp (x, y));
+    } else if (SCM_REALP (y)) {
+      return SCM_BOOL (scm_big2dbl (x) == SCM_REAL_VALUE (y));
+    } else if (SCM_COMPLEXP (y)) {
+      return SCM_BOOL ((scm_big2dbl (x) == SCM_COMPLEX_REAL (y))
+                      && (0.0 == SCM_COMPLEX_IMAG (y)));
+    } else {
+      SCM_WTA_DISPATCH_2 (g_eq_p, x, y, SCM_ARGn, s_eq_p);
+    }
+  } else if (SCM_REALP (x)) {
+    if (SCM_INUMP (y)) {
+      return SCM_BOOL (SCM_REAL_VALUE (x) == (double) SCM_INUM (y));
+    } else if (SCM_BIGP (y)) {
+      return SCM_BOOL (SCM_REAL_VALUE (x) == scm_big2dbl (y));
+    } else if (SCM_REALP (y)) {
+      return SCM_BOOL (SCM_REAL_VALUE (x) == SCM_REAL_VALUE (y));
+    } else if (SCM_COMPLEXP (y)) {
+      return SCM_BOOL ((SCM_REAL_VALUE (x) == SCM_COMPLEX_REAL (y))
+                      && (0.0 == SCM_COMPLEX_IMAG (y)));
+    } else {
+      SCM_WTA_DISPATCH_2 (g_eq_p, x, y, SCM_ARGn, s_eq_p);
+    }
+  } else if (SCM_COMPLEXP (x)) {
+    if (SCM_INUMP (y)) {
+      return SCM_BOOL ((SCM_COMPLEX_REAL (x) == (double) SCM_INUM (y))
+                      && (SCM_COMPLEX_IMAG (x) == 0.0));
+    } else if (SCM_BIGP (y)) {
+      return SCM_BOOL ((SCM_COMPLEX_REAL (x) == scm_big2dbl (y))
+                      && (SCM_COMPLEX_IMAG (x) == 0.0));
+    } else if (SCM_REALP (y)) {
+      return SCM_BOOL ((SCM_COMPLEX_REAL (x) == SCM_REAL_VALUE (y))
+                      && (SCM_COMPLEX_IMAG (x) == 0.0));
+    } else if (SCM_COMPLEXP (y)) {
+      return SCM_BOOL ((SCM_COMPLEX_REAL (x) == SCM_COMPLEX_REAL (y))
+                      && (SCM_COMPLEX_IMAG (x) == SCM_COMPLEX_IMAG (y)));
+    } else {
+      SCM_WTA_DISPATCH_2 (g_eq_p, x, y, SCM_ARGn, s_eq_p);

     }
     }

-  return SCM_BOOL((long) x == (long) y);
+  } else {
+    SCM_WTA_DISPATCH_2 (g_eq_p, x, y, SCM_ARG1, s_eq_p);
+  }

 }
 
 
 }
 
 

-

 SCM_GPROC1 (s_less_p, "<", scm_tc7_rpsubr, scm_less_p, g_less_p);
 
 SCM
 scm_less_p (SCM x, SCM y)
 {
 SCM_GPROC1 (s_less_p, "<", scm_tc7_rpsubr, scm_less_p, g_less_p);
 
 SCM
 scm_less_p (SCM x, SCM y)
 {

-  if (SCM_NINUMP (x))
-    {
-#ifdef SCM_BIGDIG
-      if (!SCM_NIMP (x))
-       {
-       badx:
-         SCM_WTA_DISPATCH_2 (g_less_p, x, y, SCM_ARG1, s_less_p);
-       }
-      if (SCM_BIGP (x))
-       {
-         if (SCM_INUMP (y))
-           return SCM_BOOL(SCM_BIGSIGN (x));
-         SCM_ASRTGO (SCM_NIMP (y), bady);
-         if (SCM_BIGP (y))
-           return SCM_BOOL(1 == scm_bigcomp (x, y));
-         SCM_ASRTGO (SCM_SLOPPY_REALP (y), bady);
-         return ((scm_big2dbl (x) < SCM_REALPART (y))
-                 ? SCM_BOOL_T
-                 : SCM_BOOL_F);
-       }
-      SCM_ASRTGO (SCM_SLOPPY_REALP (x), badx);
-#else
-      SCM_GASSERT2 (SCM_SLOPPY_REALP (x),
-                   g_less_p, x, y, SCM_ARG1, s_less_p);
-#endif
-      if (SCM_INUMP (y))
-       return ((SCM_REALPART (x) < ((double) SCM_INUM (y)))
-               ? SCM_BOOL_T
-               : SCM_BOOL_F);
-#ifdef SCM_BIGDIG
-      SCM_ASRTGO (SCM_NIMP (y), bady);
-      if (SCM_BIGP (y))
-       return SCM_BOOL(SCM_REALPART (x) < scm_big2dbl (y));
-      SCM_ASRTGO (SCM_SLOPPY_REALP (y), bady);
-#else
-      SCM_ASRTGO (SCM_SLOPPY_REALP (y), bady);
-#endif
-      return SCM_BOOL(SCM_REALPART (x) < SCM_REALPART (y));
+  if (SCM_INUMP (x)) {
+    long xx = SCM_INUM (x);
+    if (SCM_INUMP (y)) {
+      long yy = SCM_INUM (y);
+      return SCM_BOOL (xx < yy);
+    } else if (SCM_BIGP (y)) {
+      return SCM_BOOL (!SCM_BIGSIGN (y));
+    } else if (SCM_REALP (y)) {
+      return SCM_BOOL ((double) xx < SCM_REAL_VALUE (y));
+    } else {
+      SCM_WTA_DISPATCH_2 (g_less_p, x, y, SCM_ARGn, s_less_p);

     }
     }

-  if (SCM_NINUMP (y))
-    {
-#ifdef SCM_BIGDIG
-      SCM_ASRTGO (SCM_NIMP (y), bady);
-      if (SCM_BIGP (y))
-       return SCM_NEGATE_BOOL(SCM_BIGSIGN (y));
-      if (!SCM_SLOPPY_REALP (y))
-       {
-       bady:
-         SCM_WTA_DISPATCH_2 (g_less_p, x, y, SCM_ARGn, s_less_p);
-       }
-#else
-      if (!SCM_SLOPPY_REALP (y))
-       {
-       bady:
-         SCM_WTA_DISPATCH_2 (g_less_p, x, y, SCM_ARGn, s_less_p);
-       }
-#endif
-      return ((((double) SCM_INUM (x)) < SCM_REALPART (y))
-             ? SCM_BOOL_T
-             : SCM_BOOL_F);
+  } else if (SCM_BIGP (x)) {
+    if (SCM_INUMP (y)) {
+      return SCM_BOOL (SCM_BIGSIGN (x));
+    } else if (SCM_BIGP (y)) {
+      return SCM_BOOL (1 == scm_bigcomp (x, y));
+    } else if (SCM_REALP (y)) {
+      return SCM_BOOL (scm_big2dbl (x) < SCM_REAL_VALUE (y));
+    } else {
+      SCM_WTA_DISPATCH_2 (g_less_p, x, y, SCM_ARGn, s_less_p);
+    }
+  } else if (SCM_REALP (x)) {
+    if (SCM_INUMP (y)) {
+      return SCM_BOOL (SCM_REAL_VALUE (x) < (double) SCM_INUM (y));
+    } else if (SCM_BIGP (y)) {
+      return SCM_BOOL (SCM_REAL_VALUE (x) < scm_big2dbl (y));
+    } else if (SCM_REALP (y)) {
+      return SCM_BOOL (SCM_REAL_VALUE (x) < SCM_REAL_VALUE (y));
+    } else {
+      SCM_WTA_DISPATCH_2 (g_less_p, x, y, SCM_ARGn, s_less_p);

     }
     }

-  return SCM_BOOL((long) x < (long) y);
+  } else {
+    SCM_WTA_DISPATCH_2 (g_less_p, x, y, SCM_ARG1, s_less_p);
+  }

 }
 
 
 }
 
 

-SCM_DEFINE1 (scm_gr_p, ">", scm_tc7_rpsubr,
-             (SCM x, SCM y),
-            "")
+SCM_GPROC1 (s_scm_gr_p, ">", scm_tc7_rpsubr, scm_gr_p, g_gr_p);
+/* "Return #t if the list of parameters is monotonically\n"
+ *  "increasing."
+ */

 #define FUNC_NAME s_scm_gr_p
 #define FUNC_NAME s_scm_gr_p

+SCM
+scm_gr_p (SCM x, SCM y)

 {
 {

-  return scm_less_p (y, x);
+  if (!SCM_NUMBERP (x))
+    SCM_WTA_DISPATCH_2 (g_gr_p, x, y, SCM_ARG1, FUNC_NAME);
+  else if (!SCM_NUMBERP (y))
+    SCM_WTA_DISPATCH_2 (g_gr_p, x, y, SCM_ARG2, FUNC_NAME);
+  else
+    return scm_less_p (y, x);

 }
 #undef FUNC_NAME
 
 
 }
 #undef FUNC_NAME
 
 

-
-SCM_DEFINE1 (scm_leq_p, "<=", scm_tc7_rpsubr,
-             (SCM x, SCM y),
-            "")
+SCM_GPROC1 (s_scm_leq_p, "<=", scm_tc7_rpsubr, scm_leq_p, g_leq_p);
+/* "Return #t if the list of parameters is monotonically\n"
+ * "non-decreasing."
+ */

 #define FUNC_NAME s_scm_leq_p
 #define FUNC_NAME s_scm_leq_p

+SCM
+scm_leq_p (SCM x, SCM y)

 {
 {

-  return SCM_BOOL_NOT (scm_less_p (y, x));
+  if (!SCM_NUMBERP (x))
+    SCM_WTA_DISPATCH_2 (g_leq_p, x, y, SCM_ARG1, FUNC_NAME);
+  else if (!SCM_NUMBERP (y))
+    SCM_WTA_DISPATCH_2 (g_leq_p, x, y, SCM_ARG2, FUNC_NAME);
+  else
+    return SCM_BOOL_NOT (scm_less_p (y, x));

 }
 #undef FUNC_NAME
 
 
 }
 #undef FUNC_NAME
 
 

-
-SCM_DEFINE1 (scm_geq_p, ">=", scm_tc7_rpsubr,
-             (SCM x, SCM y),
-            "")
+SCM_GPROC1 (s_scm_geq_p, ">=", scm_tc7_rpsubr, scm_geq_p, g_geq_p);
+/* "Return #t if the list of parameters is monotonically\n"
+ * "non-increasing."
+ */

 #define FUNC_NAME s_scm_geq_p
 #define FUNC_NAME s_scm_geq_p

+SCM
+scm_geq_p (SCM x, SCM y)

 {
 {

+  if (!SCM_NUMBERP (x))
+    SCM_WTA_DISPATCH_2 (g_geq_p, x, y, SCM_ARG1, FUNC_NAME);
+  else if (!SCM_NUMBERP (y))
+    SCM_WTA_DISPATCH_2 (g_geq_p, x, y, SCM_ARG2, FUNC_NAME);
+  else

   return SCM_BOOL_NOT (scm_less_p (x, y));
 }
 #undef FUNC_NAME
 
 
   return SCM_BOOL_NOT (scm_less_p (x, y));
 }
 #undef FUNC_NAME
 
 

-

 SCM_GPROC (s_zero_p, "zero?", 1, 0, 0, scm_zero_p, g_zero_p);
 
 SCM
 scm_zero_p (SCM z)
 {
 SCM_GPROC (s_zero_p, "zero?", 1, 0, 0, scm_zero_p, g_zero_p);
 
 SCM
 scm_zero_p (SCM z)
 {

-  if (SCM_NINUMP (z))
-    {
-#ifdef SCM_BIGDIG
-      SCM_ASRTGO (SCM_NIMP (z), badz);
-      if (SCM_BIGP (z))
-       return SCM_BOOL_F;
-      if (!SCM_SLOPPY_INEXACTP (z))
-       {
-       badz:
-         SCM_WTA_DISPATCH_1 (g_zero_p, z, SCM_ARG1, s_zero_p);
-       }
-#else
-      SCM_GASSERT1 (SCM_SLOPPY_INEXACTP (z),
-                   g_zero_p, z, SCM_ARG1, s_zero_p);
-#endif
-      if (SCM_SLOPPY_REALP (z))
-       return SCM_BOOL (SCM_REAL_VALUE (z) == 0.0);
-      else
-       return SCM_BOOL (SCM_COMPLEX_REAL (z) == 0.0
-                        && SCM_COMPLEX_IMAG (z) == 0.0);
-    }
-  return SCM_BOOL (SCM_EQ_P (z, SCM_INUM0));
+  if (SCM_INUMP (z)) {
+    return SCM_BOOL (SCM_EQ_P (z, SCM_INUM0));
+  } else if (SCM_BIGP (z)) {
+    return SCM_BOOL_F;
+  } else if (SCM_REALP (z)) {
+    return SCM_BOOL (SCM_REAL_VALUE (z) == 0.0);
+  } else if (SCM_COMPLEXP (z)) {
+    return SCM_BOOL (SCM_COMPLEX_REAL (z) == 0.0
+                    && SCM_COMPLEX_IMAG (z) == 0.0);
+  } else {
+    SCM_WTA_DISPATCH_1 (g_zero_p, z, SCM_ARG1, s_zero_p);
+  }

 }
 
 
 }
 
 

-

 SCM_GPROC (s_positive_p, "positive?", 1, 0, 0, scm_positive_p, g_positive_p);
 
 SCM
 scm_positive_p (SCM x)
 {
 SCM_GPROC (s_positive_p, "positive?", 1, 0, 0, scm_positive_p, g_positive_p);
 
 SCM
 scm_positive_p (SCM x)
 {

-  if (SCM_NINUMP (x))
-    {
-#ifdef SCM_BIGDIG
-      SCM_ASRTGO (SCM_NIMP (x), badx);
-      if (SCM_BIGP (x))
-       return SCM_BOOL (!SCM_BIGSIGN (x));
-      if (!SCM_SLOPPY_REALP (x))
-       {
-       badx:
-         SCM_WTA_DISPATCH_1 (g_positive_p, x, SCM_ARG1, s_positive_p);
-       }
-#else
-      SCM_GASSERT1 (SCM_SLOPPY_REALP (x),
-                   g_positive_p, x, SCM_ARG1, s_positive_p);
-#endif
-      return SCM_BOOL(SCM_REALPART (x) > 0.0);
-    }
-  return SCM_BOOL(SCM_INUM(x) > 0);
+  if (SCM_INUMP (x)) {
+    return SCM_BOOL (SCM_INUM (x) > 0);
+  } else if (SCM_BIGP (x)) {
+    return SCM_BOOL (!SCM_BIGSIGN (x));
+  } else if (SCM_REALP (x)) {
+    return SCM_BOOL(SCM_REAL_VALUE (x) > 0.0);
+  } else {
+    SCM_WTA_DISPATCH_1 (g_positive_p, x, SCM_ARG1, s_positive_p);
+  }

 }
 
 
 }
 
 

-

 SCM_GPROC (s_negative_p, "negative?", 1, 0, 0, scm_negative_p, g_negative_p);
 
 SCM
 scm_negative_p (SCM x)
 {
 SCM_GPROC (s_negative_p, "negative?", 1, 0, 0, scm_negative_p, g_negative_p);
 
 SCM
 scm_negative_p (SCM x)
 {

-  if (SCM_NINUMP (x))
-    {
-#ifdef SCM_BIGDIG
-      SCM_ASRTGO (SCM_NIMP (x), badx);
-      if (SCM_BIGP (x))
-       return SCM_BOOL (SCM_BIGSIGN (x));
-      if (!(SCM_SLOPPY_REALP (x)))
-       {
-       badx:
-         SCM_WTA_DISPATCH_1 (g_negative_p, x, SCM_ARG1, s_negative_p);
-       }
-#else
-      SCM_GASSERT1 (SCM_SLOPPY_REALP (x),
-                   g_negative_p, x, SCM_ARG1, s_negative_p);
-#endif
-      return SCM_BOOL(SCM_REALPART (x) < 0.0);
-    }
-  return SCM_BOOL(SCM_INUM(x) < 0);
+  if (SCM_INUMP (x)) {
+    return SCM_BOOL (SCM_INUM (x) < 0);
+  } else if (SCM_BIGP (x)) {
+    return SCM_BOOL (SCM_BIGSIGN (x));
+  } else if (SCM_REALP (x)) {
+    return SCM_BOOL(SCM_REAL_VALUE (x) < 0.0);
+  } else {
+    SCM_WTA_DISPATCH_1 (g_negative_p, x, SCM_ARG1, s_negative_p);
+  }

 }
 
 
 }
 
 


@@ -3180,635 +3216,491 @@ SCM_GPROC1 (s_max, "max", scm_tc7_asubr, scm_max, g_max);
 SCM
 scm_max (SCM x, SCM y)
 {
 SCM
 scm_max (SCM x, SCM y)
 {

-  double z;
-  if (SCM_UNBNDP (y))
-    {
-      SCM_GASSERT0 (!SCM_UNBNDP (x),
-                   g_max, scm_makfrom0str (s_max), SCM_WNA, 0);
-      SCM_GASSERT1 (SCM_NUMBERP (x), g_max, x, SCM_ARG1, s_max);
+  if (SCM_UNBNDP (y)) {
+    if (SCM_UNBNDP (x)) {
+      SCM_WTA_DISPATCH_0 (g_max, x, SCM_ARG1, s_max);
+    } else if (SCM_NUMBERP (x)) {

       return x;
       return x;

+    } else {
+      SCM_WTA_DISPATCH_1 (g_max, x, SCM_ARG1, s_max);

     }
     }

-  if (SCM_NINUMP (x))
-    {
-#ifdef SCM_BIGDIG
-      if (!SCM_NIMP (x))
-       {
-       badx2:
-         SCM_WTA_DISPATCH_2 (g_max, x, y, SCM_ARG1, s_max);
-       }
-      if (SCM_BIGP (x))
-       {
-         if (SCM_INUMP (y))
-           return SCM_BIGSIGN (x) ? y : x;
-         SCM_ASRTGO (SCM_NIMP (y), bady);
-         if (SCM_BIGP (y))
-           return (1 == scm_bigcomp (x, y)) ? y : x;
-         SCM_ASRTGO (SCM_SLOPPY_REALP (y), bady);
-         z = scm_big2dbl (x);
-         return (z < SCM_REALPART (y)) ? y : scm_makdbl (z, 0.0);
-       }
-      SCM_ASRTGO (SCM_SLOPPY_REALP (x), badx2);
-#else
-      SCM_GASSERT2 (SCM_SLOPPY_REALP (x),
-                   g_max, x, y, SCM_ARG1, s_max);
-#endif
-      if (SCM_INUMP (y))
-       return ((SCM_REALPART (x) < (z = SCM_INUM (y)))
-               ? scm_makdbl (z, 0.0)
-               : x);
-#ifdef SCM_BIGDIG
-      SCM_ASRTGO (SCM_NIMP (y), bady);
-      if (SCM_BIGP (y))
-       return ((SCM_REALPART (x) < (z = scm_big2dbl (y)))
-               ? scm_makdbl (z, 0.0)
-               : x);
-      SCM_ASRTGO (SCM_SLOPPY_REALP (y), bady);
-#else
-      SCM_ASRTGO (SCM_SLOPPY_REALP (y), bady);
-#endif
-      return (SCM_REALPART (x) < SCM_REALPART (y)) ? y : x;
+  }
+  
+  if (SCM_INUMP (x)) {
+    long xx = SCM_INUM (x);
+    if (SCM_INUMP (y)) {
+      long yy = SCM_INUM (y);
+      return (xx < yy) ? y : x;
+    } else if (SCM_BIGP (y)) {
+      return SCM_BIGSIGN (y) ? x : y;
+    } else if (SCM_REALP (y)) {
+      double z = xx;
+      return (z <= SCM_REAL_VALUE (y)) ? y : scm_make_real (z);
+    } else {
+      SCM_WTA_DISPATCH_2 (g_max, x, y, SCM_ARGn, s_max);

     }
     }

-  if (SCM_NINUMP (y))
-    {
-#ifdef SCM_BIGDIG
-      SCM_ASRTGO (SCM_NIMP (y), bady);
-      if (SCM_BIGP (y))
-       return SCM_BIGSIGN (y) ? x : y;
-      if (!(SCM_SLOPPY_REALP (y)))
-       {
-       bady:
-         SCM_WTA_DISPATCH_2 (g_max, x, y, SCM_ARGn, s_max);
-       }
-#else
-      if (!SCM_SLOPPY_REALP (y))
-       {
-       bady:
-         SCM_WTA_DISPATCH_2 (g_max, x, y, SCM_ARGn, s_max);
-       }
-#endif
-      return (((z = SCM_INUM (x)) < SCM_REALPART (y))
-             ? y
-             : scm_makdbl (z, 0.0));
+  } else if (SCM_BIGP (x)) {
+    if (SCM_INUMP (y)) {
+      return SCM_BIGSIGN (x) ? y : x;
+    } else if (SCM_BIGP (y)) {
+      return (1 == scm_bigcomp (x, y)) ? y : x;
+    } else if (SCM_REALP (y)) {
+      double z = scm_big2dbl (x);
+      return (z <= SCM_REAL_VALUE (y)) ? y : scm_make_real (z);
+    } else {
+      SCM_WTA_DISPATCH_2 (g_max, x, y, SCM_ARGn, s_max);
+    }
+  } else if (SCM_REALP (x)) {
+    if (SCM_INUMP (y)) {
+      double z = SCM_INUM (y);
+      return (SCM_REAL_VALUE (x) < z) ? scm_make_real (z) : x;
+    } else if (SCM_BIGP (y)) {
+      double z = scm_big2dbl (y);
+      return (SCM_REAL_VALUE (x) < z) ? scm_make_real (z) : x;
+    } else if (SCM_REALP (y)) {
+      return (SCM_REAL_VALUE (x) < SCM_REAL_VALUE (y)) ? y : x;
+    } else {
+      SCM_WTA_DISPATCH_2 (g_max, x, y, SCM_ARGn, s_max);

     }
     }

-  return ((long) x < (long) y) ? y : x;
+  } else {
+    SCM_WTA_DISPATCH_2 (g_max, x, y, SCM_ARG1, s_max);
+  }

 }
 
 
 }
 
 

-#define SCM_SWAP(x,y) do { SCM t = x; x = y; y = t; } while (0)
-
-
-

 SCM_GPROC1 (s_min, "min", scm_tc7_asubr, scm_min, g_min);
 
 SCM
 scm_min (SCM x, SCM y)
 {
 SCM_GPROC1 (s_min, "min", scm_tc7_asubr, scm_min, g_min);
 
 SCM
 scm_min (SCM x, SCM y)
 {

-  double z;
-  if (SCM_UNBNDP (y))
-    {
-      SCM_GASSERT0 (!SCM_UNBNDP (x),
-                   g_min, scm_makfrom0str (s_min), SCM_WNA, 0);
-      SCM_GASSERT1 (SCM_NUMBERP (x), g_min, x, SCM_ARG1, s_min);
+  if (SCM_UNBNDP (y)) {
+    if (SCM_UNBNDP (x)) {
+      SCM_WTA_DISPATCH_0 (g_min, x, SCM_ARG1, s_min);
+    } else if (SCM_NUMBERP (x)) {

       return x;
       return x;

+    } else {
+      SCM_WTA_DISPATCH_1 (g_min, x, SCM_ARG1, s_min);

     }
     }

-  if (SCM_NINUMP (x))
-    {
-#ifdef SCM_BIGDIG
-      if (!SCM_NIMP (x))
-       {
-       badx2:
-         SCM_WTA_DISPATCH_2 (g_min, x, y, SCM_ARG1, s_min);
-       }
-      if (SCM_BIGP (x))
-       {
-         if (SCM_INUMP (y))
-           return SCM_BIGSIGN (x) ? x : y;
-         SCM_ASRTGO (SCM_NIMP (y), bady);
-         if (SCM_BIGP (y))
-           return (-1 == scm_bigcomp (x, y)) ? y : x;
-         SCM_ASRTGO (SCM_SLOPPY_REALP (y), bady);
-         z = scm_big2dbl (x);
-         return (z > SCM_REALPART (y)) ? y : scm_makdbl (z, 0.0);
-       }
-      SCM_ASRTGO (SCM_SLOPPY_REALP (x), badx2);
-#else
-      SCM_GASSERT2 (SCM_SLOPPY_REALP (x),
-                   g_min, x, y, SCM_ARG1, s_min);
-#endif
-      if (SCM_INUMP (y))
-       return ((SCM_REALPART (x) > (z = SCM_INUM (y)))
-               ? scm_makdbl (z, 0.0)
-               : x);
-#ifdef SCM_BIGDIG
-      SCM_ASRTGO (SCM_NIMP (y), bady);
-      if (SCM_BIGP (y))
-       return ((SCM_REALPART (x) > (z = scm_big2dbl (y)))
-               ? scm_makdbl (z, 0.0)
-               : x);
-      SCM_ASRTGO (SCM_SLOPPY_REALP (y), bady);
-#else
-      SCM_ASRTGO (SCM_SLOPPY_REALP (y), bady);
-#endif
-      return (SCM_REALPART (x) > SCM_REALPART (y)) ? y : x;
+  }
+  
+  if (SCM_INUMP (x)) {
+    long xx = SCM_INUM (x);
+    if (SCM_INUMP (y)) {
+      long yy = SCM_INUM (y);
+      return (xx < yy) ? x : y;
+    } else if (SCM_BIGP (y)) {
+      return SCM_BIGSIGN (y) ? y : x;
+    } else if (SCM_REALP (y)) {
+      double z = xx;
+      return (z < SCM_REAL_VALUE (y)) ? scm_make_real (z) : y;
+    } else {
+      SCM_WTA_DISPATCH_2 (g_min, x, y, SCM_ARGn, s_min);

     }
     }

-  if (SCM_NINUMP (y))
-    {
-#ifdef SCM_BIGDIG
-      SCM_ASRTGO (SCM_NIMP (y), bady);
-      if (SCM_BIGP (y))
-       return SCM_BIGSIGN (y) ? y : x;
-      if (!(SCM_SLOPPY_REALP (y)))
-       {
-       bady:
-         SCM_WTA_DISPATCH_2 (g_min, x, y, SCM_ARGn, s_min);
-       }
-#else
-      if (!SCM_SLOPPY_REALP (y))
-       {
-       bady:
-         SCM_WTA_DISPATCH_2 (g_min, x, y, SCM_ARGn, s_min);
-       }
-#endif
-      return (((z = SCM_INUM (x)) > SCM_REALPART (y))
-             ? y
-             : scm_makdbl (z, 0.0));
+  } else if (SCM_BIGP (x)) {
+    if (SCM_INUMP (y)) {
+      return SCM_BIGSIGN (x) ? x : y;
+    } else if (SCM_BIGP (y)) {
+      return (-1 == scm_bigcomp (x, y)) ? y : x;
+    } else if (SCM_REALP (y)) {
+      double z = scm_big2dbl (x);
+      return (z < SCM_REAL_VALUE (y)) ? scm_make_real (z) : y;
+    } else {
+      SCM_WTA_DISPATCH_2 (g_min, x, y, SCM_ARGn, s_min);
+    }
+  } else if (SCM_REALP (x)) {
+    if (SCM_INUMP (y)) {
+      double z = SCM_INUM (y);
+      return (SCM_REAL_VALUE (x) <= z) ? x : scm_make_real (z);
+    } else if (SCM_BIGP (y)) {
+      double z = scm_big2dbl (y);
+      return (SCM_REAL_VALUE (x) <= z) ? x : scm_make_real (z);
+    } else if (SCM_REALP (y)) {
+      return (SCM_REAL_VALUE (x) < SCM_REAL_VALUE (y)) ? x : y;
+    } else {
+      SCM_WTA_DISPATCH_2 (g_min, x, y, SCM_ARGn, s_min);

     }
     }

-  return ((long) x > (long) y) ? y : x;
+  } else {
+    SCM_WTA_DISPATCH_2 (g_min, x, y, SCM_ARG1, s_min);
+  }

 }
 
 
 }
 
 

-
-

 SCM_GPROC1 (s_sum, "+", scm_tc7_asubr, scm_sum, g_sum);
 
 SCM_GPROC1 (s_sum, "+", scm_tc7_asubr, scm_sum, g_sum);
 

-/*
-  This is sick, sick, sick code.
-
- */

 SCM
 scm_sum (SCM x, SCM y)
 {
 SCM
 scm_sum (SCM x, SCM y)
 {

-  if (SCM_UNBNDP (y))
-    {
-      if (SCM_UNBNDP (x))
-       return SCM_INUM0;
-      SCM_GASSERT1 (SCM_NUMBERP (x), g_sum, x, SCM_ARG1, s_sum);
+  if (SCM_UNBNDP (y)) {
+    if (SCM_UNBNDP (x)) {
+      return SCM_INUM0;
+    } else if (SCM_NUMBERP (x)) {

       return x;
       return x;

+    } else {
+      SCM_WTA_DISPATCH_1 (g_sum, x, SCM_ARG1, s_sum);

     }
     }

-  if (SCM_NINUMP (x))
-    {
-# ifdef SCM_BIGDIG
-      if (!SCM_NIMP (x))
-       {
-       badx2:
-         SCM_WTA_DISPATCH_2 (g_sum, x, y, SCM_ARG1, s_sum);
-       }
-      if (SCM_BIGP (x))
-       {
-         if (SCM_INUMP (y))
-           {
-             SCM_SWAP(x,y);
-             goto intbig;
-           }
-         SCM_ASRTGO (SCM_NIMP (y), bady);
-         if (SCM_BIGP (y))
-           {
-             if (SCM_NUMDIGS (x) > SCM_NUMDIGS (y))
-               {
-                 SCM_SWAP(x,y);
-               }
-             return scm_addbig (SCM_BDIGITS (x), SCM_NUMDIGS (x),
-                                SCM_BIGSIGN (x),
-                                y, 0);
-           }
-         SCM_ASRTGO (SCM_SLOPPY_INEXACTP (y), bady);
-       bigreal:
-         if (SCM_SLOPPY_REALP (y))
-           return scm_make_real (scm_big2dbl (x) + SCM_REAL_VALUE (y));
-         else
-           return scm_make_complex (scm_big2dbl (x) + SCM_COMPLEX_REAL (y),
-                                    SCM_COMPLEX_IMAG (y));
-       }
-# endif /* SCM_BIGDIG */
-      SCM_ASRTGO (SCM_SLOPPY_INEXACTP (x), badx2);
+  }

 
 

-      if (SCM_INUMP (y))
-       {
-         SCM_SWAP(x,y);
-         goto intreal;
-       }
-# ifdef SCM_BIGDIG
-      SCM_ASRTGO (SCM_NIMP (y), bady);
-      if (SCM_BIGP (y))
-       {
-         SCM_SWAP(x,y);
-         goto bigreal;
-       }
-      else if (!SCM_SLOPPY_INEXACTP (y))
-       {
-       bady:
-         SCM_WTA_DISPATCH_2 (g_sum, x, y, SCM_ARGn, s_sum);
-       }
-# else  /* SCM_BIGDIG */
-      if (!SCM_SLOPPY_INEXACTP (y))
-       {
-       bady:
-         SCM_WTA_DISPATCH_2 (g_sum, x, y, SCM_ARGn, s_sum);
-       }
-# endif /* SCM_BIGDIG */
+  if (SCM_INUMP (x)) {
+    long int xx = SCM_INUM (x);
+    if (SCM_INUMP (y)) {
+      long int yy = SCM_INUM (y);
+      long int z = xx + yy;
+      if (SCM_FIXABLE (z)) {
+       return SCM_MAKINUM (z);
+      } else {
+#ifdef SCM_BIGDIG
+       return scm_long2big (z);
+#else  /* SCM_BIGDIG */
+       return scm_make_real ((double) z);
+#endif /* SCM_BIGDIG */ 
+      }
+    } else if (SCM_BIGP (y)) {
+    intbig:

       {
       {

-       double i = 0.0;
-       if (SCM_SLOPPY_COMPLEXP (x))
-         i = SCM_COMPLEX_IMAG (x);
-       if (SCM_SLOPPY_COMPLEXP (y))
-         i += SCM_COMPLEX_IMAG (y);
-       return scm_makdbl (SCM_REALPART (x) + SCM_REALPART (y), i);
+       long int xx = SCM_INUM (x);
+#ifndef SCM_DIGSTOOBIG
+       long z = scm_pseudolong (xx);
+       return scm_addbig ((SCM_BIGDIG *) & z, SCM_DIGSPERLONG,
+                          (xx < 0) ? SCM_BIGSIGNFLAG : 0, y, 0);
+#else  /* SCM_DIGSTOOBIG */
+       SCM_BIGDIG zdigs [SCM_DIGSPERLONG];
+       scm_longdigs (xx, zdigs);
+       return scm_addbig (zdigs, SCM_DIGSPERLONG, 
+                          (xx < 0) ? SCM_BIGSIGNFLAG : 0, y, 0);
+#endif /* SCM_DIGSTOOBIG */

       }
       }

+    } else if (SCM_REALP (y)) {
+      return scm_make_real (xx + SCM_REAL_VALUE (y));
+    } else if (SCM_COMPLEXP (y)) {
+      return scm_make_complex (xx + SCM_COMPLEX_REAL (y),
+                              SCM_COMPLEX_IMAG (y));
+    } else {
+      SCM_WTA_DISPATCH_2 (g_sum, x, y, SCM_ARGn, s_sum);

     }
     }

-  if (SCM_NINUMP (y))
-    {
-# ifdef SCM_BIGDIG
-      SCM_ASRTGO (SCM_NIMP (y), bady);
-      if (SCM_BIGP (y))
-       {
-       intbig:
-         {
-           long i = SCM_INUM (x);
-#  ifndef SCM_DIGSTOOBIG
-           long z = scm_pseudolong (i);
-           return scm_addbig ((SCM_BIGDIG *) & z,
-                              SCM_DIGSPERLONG,
-                              (i < 0) ? SCM_BIGSIGNFLAG : 0,
-                              y, 0);
-#  else  /* SCM_DIGSTOOBIG */
-           SCM_BIGDIG zdigs[SCM_DIGSPERLONG];
-           scm_longdigs (i, zdigs);
-           return scm_addbig (zdigs, SCM_DIGSPERLONG, (i < 0) ? SCM_BIGSIGNFLAG : 0,
-                              y, 0);
-#  endif /* SCM_DIGSTOOBIG */
-         }
-       }
-# endif /* SCM_BIGDIG */
-      SCM_ASRTGO (SCM_SLOPPY_INEXACTP (y), bady);
-    intreal:
-      if (SCM_REALP (y))
-       return scm_make_real (SCM_INUM (x) + SCM_REAL_VALUE (y));
-      else
-       return scm_make_complex (SCM_INUM (x) + SCM_COMPLEX_REAL (y),
-                                SCM_COMPLEX_IMAG (y));
+  } else if (SCM_BIGP (x)) {
+    if (SCM_INUMP (y)) {
+      SCM_SWAP (x, y);
+      goto intbig;
+    } else if (SCM_BIGP (y)) {
+      if (SCM_NUMDIGS (x) > SCM_NUMDIGS (y)) {
+       SCM_SWAP (x, y);
+      }
+      return scm_addbig (SCM_BDIGITS (x), SCM_NUMDIGS (x), 
+                        SCM_BIGSIGN (x), y, 0);
+    } else if (SCM_REALP (y)) {
+      return scm_make_real (scm_big2dbl (x) + SCM_REAL_VALUE (y));
+    } else if (SCM_COMPLEXP (y)) {
+      return scm_make_complex (scm_big2dbl (x) + SCM_COMPLEX_REAL (y),
+                              SCM_COMPLEX_IMAG (y));
+    } else {
+      SCM_WTA_DISPATCH_2 (g_sum, x, y, SCM_ARGn, s_sum);

     }
     }

-  { /* scope */
-    long int i = SCM_INUM (x) + SCM_INUM (y);
-    if (SCM_FIXABLE (i))
-      return SCM_MAKINUM (i);
-#ifdef SCM_BIGDIG
-    return scm_long2big (i);
-#else  /* SCM_BIGDIG */
-    return scm_makdbl ((double) i, 0.0);
-#endif /* SCM_BIGDIG */ 
-  } /* end scope */
+  } else if (SCM_REALP (x)) {
+    if (SCM_INUMP (y)) {
+      return scm_make_real (SCM_REAL_VALUE (x) + SCM_INUM (y));
+    } else if (SCM_BIGP (y)) {
+      return scm_make_real (SCM_REAL_VALUE (x) + scm_big2dbl (y));
+    } else if (SCM_REALP (y)) {
+      return scm_make_real (SCM_REAL_VALUE (x) + SCM_REAL_VALUE (y));
+    } else if (SCM_COMPLEXP (y)) {
+      return scm_make_complex (SCM_REAL_VALUE (x) + SCM_COMPLEX_REAL (y),
+                              SCM_COMPLEX_IMAG (y));
+    } else {
+      SCM_WTA_DISPATCH_2 (g_sum, x, y, SCM_ARGn, s_sum);
+    }
+  } else if (SCM_COMPLEXP (x)) {
+    if (SCM_INUMP (y)) {
+      return scm_make_complex (SCM_COMPLEX_REAL (x) + SCM_INUM (y),
+                              SCM_COMPLEX_IMAG (x));
+    } else if (SCM_BIGP (y)) {
+      return scm_make_complex (SCM_COMPLEX_REAL (x) + scm_big2dbl (y),
+                              SCM_COMPLEX_IMAG (x));
+    } else if (SCM_REALP (y)) {
+      return scm_make_complex (SCM_COMPLEX_REAL (x) + SCM_REAL_VALUE (y),
+                              SCM_COMPLEX_IMAG (x));
+    } else if (SCM_COMPLEXP (y)) {
+      return scm_make_complex (SCM_COMPLEX_REAL (x) + SCM_COMPLEX_REAL (y),
+                              SCM_COMPLEX_IMAG (x) + SCM_COMPLEX_IMAG (y));
+    } else {
+      SCM_WTA_DISPATCH_2 (g_sum, x, y, SCM_ARGn, s_sum);
+    }
+  } else {
+    SCM_WTA_DISPATCH_2 (g_sum, x, y, SCM_ARG1, s_sum);
+  }

 }
 
 
 }
 
 

-
-

 SCM_GPROC1 (s_difference, "-", scm_tc7_asubr, scm_difference, g_difference);
 
 SCM_GPROC1 (s_difference, "-", scm_tc7_asubr, scm_difference, g_difference);
 

-/*
-  HWN:FIXME:: This is sick,sick, sick code. Rewrite me.
-*/

 SCM
 scm_difference (SCM x, SCM y)
 {
 SCM
 scm_difference (SCM x, SCM y)
 {

-  long int cx = 0;
-  if (SCM_NINUMP (x))
-    {
-      if (!SCM_NIMP (x))
-       {
-         if (SCM_UNBNDP (y))
-           {
-             SCM_GASSERT0 (!SCM_UNBNDP (x), g_difference,
-                           scm_makfrom0str (s_difference), SCM_WNA, 0);
-           badx:
-             SCM_WTA_DISPATCH_1 (g_difference, x, SCM_ARG1, s_difference);
-           }
-         else
-           {
-           badx2:
-             SCM_WTA_DISPATCH_2 (g_difference, x, y, SCM_ARG1, s_difference);
-           }
-       }
-      if (SCM_UNBNDP (y))
-       {
-#ifdef SCM_BIGDIG
-         if (SCM_BIGP (x))
-           {
-             x = scm_copybig (x, !SCM_BIGSIGN (x));
-             return (SCM_NUMDIGS (x) * SCM_BITSPERDIG / SCM_CHAR_BIT
-                     <= sizeof (SCM)
-                     ? scm_big2inum (x, SCM_NUMDIGS (x))
-                     : x);
-           }
-#endif
-         SCM_ASRTGO (SCM_SLOPPY_INEXACTP (x), badx);
-         if (SCM_SLOPPY_REALP (x))
-           return scm_make_real (- SCM_REAL_VALUE (x));
-         else
-           return scm_make_complex (- SCM_COMPLEX_REAL (x),
-                                    - SCM_COMPLEX_IMAG (x));
-       }
-      if (SCM_INUMP (y))
-       return scm_sum (x, SCM_MAKINUM (- SCM_INUM (y)));
+  if (SCM_UNBNDP (y)) {
+    if (SCM_INUMP (x)) {
+      long xx = -SCM_INUM (x);
+      if (SCM_FIXABLE (xx)) {
+       return SCM_MAKINUM (xx);
+      } else {

 #ifdef SCM_BIGDIG
 #ifdef SCM_BIGDIG

-      SCM_ASRTGO (SCM_NIMP (y), bady);
-      if (SCM_BIGP (x))
-       {
-         if (SCM_BIGP (y))
-           return ((SCM_NUMDIGS (x) < SCM_NUMDIGS (y))
-                   ? scm_addbig (SCM_BDIGITS (x), SCM_NUMDIGS (x),
-                                 SCM_BIGSIGN (x),
-                                 y, SCM_BIGSIGNFLAG)
-                   : scm_addbig (SCM_BDIGITS (y), SCM_NUMDIGS (y),
-                                 SCM_BIGSIGN (y) ^ SCM_BIGSIGNFLAG,
-                                 x, 0));
-         SCM_ASRTGO (SCM_SLOPPY_INEXACTP (y), bady);
-         if (SCM_REALP (y))
-           return scm_make_real (scm_big2dbl (x) - SCM_REAL_VALUE (y));
-         else
-           return scm_make_complex (scm_big2dbl (x) - SCM_COMPLEX_REAL (y),
-                                    - SCM_COMPLEX_IMAG (y));
-       }
-      SCM_ASRTGO (SCM_SLOPPY_INEXACTP (x), badx2);
-      if (SCM_BIGP (y))
-       {
-         if (SCM_REALP (x))
-           return scm_make_real (SCM_REAL_VALUE (x) - scm_big2dbl (y));
-         else
-           return scm_make_complex (SCM_COMPLEX_REAL (x) - scm_big2dbl (y),
-                                    SCM_COMPLEX_IMAG (x));
-       }
-      SCM_ASRTGO (SCM_SLOPPY_INEXACTP (y), bady);
+       return scm_long2big (xx);

 #else
 #else

-      SCM_ASRTGO (SCM_SLOPPY_INEXACTP (x), badx2);
-      SCM_ASRTGO (SCM_SLOPPY_INEXACTP (y), bady);
+       return scm_make_real ((double) xx);

 #endif
 #endif

-      {
-       SCM z;
-       if (SCM_SLOPPY_COMPLEXP (x))
-         {
-           if (SCM_SLOPPY_COMPLEXP (y))
-             SCM_NEWCOMPLEX (z,
-                             SCM_COMPLEX_REAL (x) - SCM_COMPLEX_REAL (y),
-                             SCM_COMPLEX_IMAG (x) - SCM_COMPLEX_IMAG (y));
-           else
-             SCM_NEWCOMPLEX (z,
-                             SCM_COMPLEX_REAL (x) - SCM_REAL_VALUE (y),
-                             SCM_COMPLEX_IMAG (x));
-         }
-       else
-         {
-           if (SCM_SLOPPY_COMPLEXP (y))
-             SCM_NEWCOMPLEX (z,
-                             SCM_REAL_VALUE (x) - SCM_COMPLEX_REAL (y),
-                             - SCM_COMPLEX_IMAG (y));
-           else
-             SCM_NEWREAL (z, SCM_REAL_VALUE (x) - SCM_REAL_VALUE (y));
-         }
-       return z;

       }
       }

+    } else if (SCM_BIGP (x)) {
+      SCM z = scm_copybig (x, !SCM_BIGSIGN (x));
+      unsigned int digs = SCM_NUMDIGS (z);
+      unsigned int size = digs * SCM_BITSPERDIG / SCM_CHAR_BIT;
+      return size <= sizeof (SCM) ? scm_big2inum (z, digs) : z;
+    } else if (SCM_REALP (x)) {
+      return scm_make_real (-SCM_REAL_VALUE (x));
+    } else if (SCM_COMPLEXP (x)) {
+      return scm_make_complex (-SCM_COMPLEX_REAL (x), -SCM_COMPLEX_IMAG (x));
+    } else {
+      SCM_WTA_DISPATCH_1 (g_difference, x, SCM_ARG1, s_difference);

     }
     }

-  if (SCM_UNBNDP (y))
-    {
-      cx = -SCM_INUM (x);
-      goto checkx;
-    }
-  if (SCM_NINUMP (y))
-    {
+  }
+
+  if (SCM_INUMP (x)) {
+    long int xx = SCM_INUM (x);
+    if (SCM_INUMP (y)) {
+      long int yy = SCM_INUM (y);
+      long int z = xx - yy;
+      if (SCM_FIXABLE (z)) {
+       return SCM_MAKINUM (z);
+      } else {

 #ifdef SCM_BIGDIG
 #ifdef SCM_BIGDIG

-      SCM_ASRTGO (SCM_NIMP (y), bady);
-      if (SCM_BIGP (y))
-       {
-         long i = SCM_INUM (x);
-#ifndef SCM_DIGSTOOBIG
-         long z = scm_pseudolong (i);
-         return scm_addbig ((SCM_BIGDIG *) & z, SCM_DIGSPERLONG,
-                            (i < 0) ? SCM_BIGSIGNFLAG : 0,
-                            y, SCM_BIGSIGNFLAG);
+       return scm_long2big (z);

 #else
 #else

-         SCM_BIGDIG zdigs[SCM_DIGSPERLONG];
-         scm_longdigs (i, zdigs);
-         return scm_addbig (zdigs, SCM_DIGSPERLONG, (i < 0) ? SCM_BIGSIGNFLAG : 0,
-                            y, SCM_BIGSIGNFLAG);
+       return scm_make_real ((double) z);

 #endif
 #endif

-       }
-      if (!SCM_SLOPPY_INEXACTP (y))
-       {
-       bady:
-         SCM_WTA_DISPATCH_2 (g_difference, x, y, SCM_ARGn, s_difference);
-       }
+      }
+    } else if (SCM_BIGP (y)) {
+#ifndef SCM_DIGSTOOBIG
+      long z = scm_pseudolong (xx);
+      return scm_addbig ((SCM_BIGDIG *) & z, SCM_DIGSPERLONG,
+                        (xx < 0) ? SCM_BIGSIGNFLAG : 0, y, SCM_BIGSIGNFLAG);

 #else
 #else

-      if (!SCM_SLOPPY_INEXACTP (y))
-       {
-       bady:
-         SCM_WTA_DISPATCH_2 (g_difference, x, y, SCM_ARGn, s_difference);
-       }
+      SCM_BIGDIG zdigs [SCM_DIGSPERLONG];
+      scm_longdigs (xx, zdigs);
+      return scm_addbig (zdigs, SCM_DIGSPERLONG, 
+                        (xx < 0) ? SCM_BIGSIGNFLAG : 0, y, SCM_BIGSIGNFLAG);

 #endif
 #endif

-      return scm_makdbl (SCM_INUM (x) - SCM_REALPART (y),
-                        SCM_SLOPPY_COMPLEXP (y) ? -SCM_IMAG (y) : 0.0);
+    } else if (SCM_REALP (y)) {
+      return scm_make_real (xx - SCM_REAL_VALUE (y));
+    } else if (SCM_COMPLEXP (y)) {
+      return scm_make_complex (xx - SCM_COMPLEX_REAL (y),
+                              -SCM_COMPLEX_IMAG (y));
+    } else {
+      SCM_WTA_DISPATCH_2 (g_difference, x, y, SCM_ARGn, s_difference);

     }
     }

-  cx = SCM_INUM (x) - SCM_INUM (y);
- checkx:
-  if (SCM_FIXABLE (cx))
-    return SCM_MAKINUM (cx);
-#ifdef SCM_BIGDIG
-  return scm_long2big (cx);
+  } else if (SCM_BIGP (x)) {
+    if (SCM_INUMP (y)) {
+      long int yy = SCM_INUM (y);
+#ifndef SCM_DIGSTOOBIG
+      long z = scm_pseudolong (yy);
+      return scm_addbig ((SCM_BIGDIG *) & z, SCM_DIGSPERLONG,
+                        (yy < 0) ? 0 : SCM_BIGSIGNFLAG, x, 0);

 #else
 #else

-  return scm_makdbl ((double) cx, 0.0);
+      SCM_BIGDIG zdigs [SCM_DIGSPERLONG];
+      scm_longdigs (yy, zdigs);
+      return scm_addbig (zdigs, SCM_DIGSPERLONG, 
+                        (yy < 0) ? 0 : SCM_BIGSIGNFLAG, x, 0);

 #endif
 #endif

+    } else if (SCM_BIGP (y)) {
+      return (SCM_NUMDIGS (x) < SCM_NUMDIGS (y))
+       ? scm_addbig (SCM_BDIGITS (x), SCM_NUMDIGS (x),
+                     SCM_BIGSIGN (x), y, SCM_BIGSIGNFLAG)
+       : scm_addbig (SCM_BDIGITS (y), SCM_NUMDIGS (y),
+                     SCM_BIGSIGN (y) ^ SCM_BIGSIGNFLAG, x, 0);
+    } else if (SCM_REALP (y)) {
+      return scm_make_real (scm_big2dbl (x) - SCM_REAL_VALUE (y));
+    } else if (SCM_COMPLEXP (y)) {
+      return scm_make_complex (scm_big2dbl (x) - SCM_COMPLEX_REAL (y),
+                              - SCM_COMPLEX_IMAG (y));
+    } else {
+      SCM_WTA_DISPATCH_2 (g_difference, x, y, SCM_ARGn, s_difference);
+    }
+  } else if (SCM_REALP (x)) {
+    if (SCM_INUMP (y)) {
+      return scm_make_real (SCM_REAL_VALUE (x) - SCM_INUM (y));
+    } else if (SCM_BIGP (y)) {
+      return scm_make_real (SCM_REAL_VALUE (x) - scm_big2dbl (y));
+    } else if (SCM_REALP (y)) {
+      return scm_make_real (SCM_REAL_VALUE (x) - SCM_REAL_VALUE (y));
+    } else if (SCM_COMPLEXP (y)) {
+      return scm_make_complex (SCM_REAL_VALUE (x) - SCM_COMPLEX_REAL (y),
+                              -SCM_COMPLEX_IMAG (y));
+    } else {
+      SCM_WTA_DISPATCH_2 (g_difference, x, y, SCM_ARGn, s_difference);
+    }
+  } else if (SCM_COMPLEXP (x)) {
+    if (SCM_INUMP (y)) {
+      return scm_make_complex (SCM_COMPLEX_REAL (x) - SCM_INUM (y),
+                              SCM_COMPLEX_IMAG (x));
+    } else if (SCM_BIGP (y)) {
+      return scm_make_complex (SCM_COMPLEX_REAL (x) - scm_big2dbl (y),
+                              SCM_COMPLEX_IMAG (x));
+    } else if (SCM_REALP (y)) {
+      return scm_make_complex (SCM_COMPLEX_REAL (x) - SCM_REAL_VALUE (y),
+                              SCM_COMPLEX_IMAG (x));
+    } else if (SCM_COMPLEXP (y)) {
+      return scm_make_complex (SCM_COMPLEX_REAL (x) - SCM_COMPLEX_REAL (y),
+                              SCM_COMPLEX_IMAG (x) - SCM_COMPLEX_IMAG (y));
+    } else {
+      SCM_WTA_DISPATCH_2 (g_difference, x, y, SCM_ARGn, s_difference);
+    }
+  } else {
+    SCM_WTA_DISPATCH_2 (g_difference, x, y, SCM_ARG1, s_difference);
+  }

 }
 
 
 }
 
 

-
-

 SCM_GPROC1 (s_product, "*", scm_tc7_asubr, scm_product, g_product);
 
 SCM
 scm_product (SCM x, SCM y)
 {
 SCM_GPROC1 (s_product, "*", scm_tc7_asubr, scm_product, g_product);
 
 SCM
 scm_product (SCM x, SCM y)
 {

-  if (SCM_UNBNDP (y))
-    {
-      if (SCM_UNBNDP (x))
-       return SCM_MAKINUM (1L);
-      SCM_GASSERT1 (SCM_NUMBERP (x), g_product, x, SCM_ARG1, s_product);
+  if (SCM_UNBNDP (y)) {
+    if (SCM_UNBNDP (x)) {
+      return SCM_MAKINUM (1L);
+    } else if (SCM_NUMBERP (x)) {

       return x;
       return x;

+    } else {
+      SCM_WTA_DISPATCH_1 (g_product, x, SCM_ARG1, s_product);

     }
     }

-  if (SCM_NINUMP (x))
-    {
-      SCM t;
-#ifdef SCM_BIGDIG
-      if (!SCM_NIMP (x))
-       {
-       badx2:
-         SCM_WTA_DISPATCH_2 (g_product, x, y, SCM_ARG1, s_product);
-       }
-      if (SCM_BIGP (x))
-       {
-         if (SCM_INUMP (y))
-           {
-             t = x;
-             x = y;
-             y = t;
-             goto intbig;
-           }
-         SCM_ASRTGO (SCM_NIMP (y), bady);
-         if (SCM_BIGP (y))
-           return scm_mulbig (SCM_BDIGITS (x), SCM_NUMDIGS (x),
-                              SCM_BDIGITS (y), SCM_NUMDIGS (y),
-                              SCM_BIGSIGN (x) ^ SCM_BIGSIGN (y));
-         SCM_ASRTGO (SCM_SLOPPY_INEXACTP (y), bady);
-       bigreal:
-         {
-           double bg = scm_big2dbl (x);
-           return scm_makdbl (bg * SCM_REALPART (y),
-                              SCM_SLOPPY_COMPLEXP (y) ? bg * SCM_IMAG (y) : 0.0);
-         }
-       }
-      SCM_ASRTGO (SCM_SLOPPY_INEXACTP (x), badx2);
-#else
-      SCM_ASRTGO (SCM_SLOPPY_INEXACTP (x), badx2);
-#endif
-      if (SCM_INUMP (y))
-       {
-         t = x;
-         x = y;
-         y = t;
-         goto intreal;
-       }
-#ifdef SCM_BIGDIG
-      SCM_ASRTGO (SCM_NIMP (y), bady);
-      if (SCM_BIGP (y))
-       {
-         t = x;
-         x = y;
-         y = t;
-         goto bigreal;
-       }
-      else if (!(SCM_SLOPPY_INEXACTP (y)))
-       {
-       bady:
-         SCM_WTA_DISPATCH_2 (g_product, x, y, SCM_ARGn, s_product);
-       }
-#else
-      if (!SCM_SLOPPY_INEXACTP (y))
-       {
-       bady:
-         SCM_WTA_DISPATCH_2 (g_product, x, y, SCM_ARGn, s_product);
-       }
-#endif
-      if (SCM_SLOPPY_COMPLEXP (x))
-       {
-         if (SCM_SLOPPY_COMPLEXP (y))
-           return scm_makdbl (SCM_REAL (x) * SCM_REAL (y)
-                              - SCM_IMAG (x) * SCM_IMAG (y),
-                              SCM_REAL (x) * SCM_IMAG (y)
-                              + SCM_IMAG (x) * SCM_REAL (y));
-         else
-           return scm_makdbl (SCM_REAL (x) * SCM_REALPART (y),
-                              SCM_IMAG (x) * SCM_REALPART (y));
-       }
-      return scm_makdbl (SCM_REALPART (x) * SCM_REALPART (y),
-                        SCM_SLOPPY_COMPLEXP (y)
-                        ? SCM_REALPART (x) * SCM_IMAG (y)
-                        : 0.0);
-    }
-  if (SCM_NINUMP (y))
-    {
-#ifdef SCM_BIGDIG
-      SCM_ASRTGO (SCM_NIMP (y), bady);
-      if (SCM_BIGP (y))
-       {
-       intbig:
-         if (SCM_EQ_P (x, SCM_INUM0))
-           return x;
-         if (SCM_EQ_P (x, SCM_MAKINUM (1L)))
-           return y;
-         {
-#ifndef SCM_DIGSTOOBIG
-           long z = scm_pseudolong (SCM_INUM (x));
-           return scm_mulbig ((SCM_BIGDIG *) & z, SCM_DIGSPERLONG,
-                              SCM_BDIGITS (y), SCM_NUMDIGS (y),
-                              SCM_BIGSIGN (y) ? (x > 0) : (x < 0));
-#else
-           SCM_BIGDIG zdigs[SCM_DIGSPERLONG];
-           scm_longdigs (SCM_INUM (x), zdigs);
-           return scm_mulbig (zdigs, SCM_DIGSPERLONG,
-                              SCM_BDIGITS (y), SCM_NUMDIGS (y),
-                              SCM_BIGSIGN (y) ? (x > 0) : (x < 0));
-#endif
-         }
-       }
-      SCM_ASRTGO (SCM_SLOPPY_INEXACTP (y), bady);
-#else
-      SCM_ASRTGO (SCM_SLOPPY_INEXACTP (y), bady);
-#endif
-    intreal:
-      return scm_makdbl (SCM_INUM (x) * SCM_REALPART (y),
-                        SCM_SLOPPY_COMPLEXP (y) ? SCM_INUM (x) * SCM_IMAG (y) : 0.0);
-    }
-  {
-    long i, j, k;
-    i = SCM_INUM (x);
-    if (0 == i)
+  }
+
+  if (SCM_INUMP (x)) {
+    long xx;
+
+  intbig:
+    xx = SCM_INUM (x);
+
+    if (xx == 0) {

       return x;
       return x;

-    j = SCM_INUM (y);
-    k = i * j;
-    y = SCM_MAKINUM (k);
-    if (k != SCM_INUM (y) || k / i != j)
+    } else if (xx == 1) {
+      return y;
+    }
+
+    if (SCM_INUMP (y)) {
+      long yy = SCM_INUM (y);
+      long kk = xx * yy;
+      SCM k = SCM_MAKINUM (kk);
+      if (kk != SCM_INUM (k) || kk / xx != yy) {

 #ifdef SCM_BIGDIG
 #ifdef SCM_BIGDIG

-      {
-       int sgn = (i < 0) ^ (j < 0);
+       int sgn = (xx < 0) ^ (yy < 0);

 #ifndef SCM_DIGSTOOBIG
 #ifndef SCM_DIGSTOOBIG

-       i = scm_pseudolong (i);
-       j = scm_pseudolong (j);
+       long i = scm_pseudolong (xx);
+       long j = scm_pseudolong (yy);

        return scm_mulbig ((SCM_BIGDIG *) & i, SCM_DIGSPERLONG,
                           (SCM_BIGDIG *) & j, SCM_DIGSPERLONG, sgn);
 #else /* SCM_DIGSTOOBIG */
        return scm_mulbig ((SCM_BIGDIG *) & i, SCM_DIGSPERLONG,
                           (SCM_BIGDIG *) & j, SCM_DIGSPERLONG, sgn);
 #else /* SCM_DIGSTOOBIG */

-       SCM_BIGDIG idigs[SCM_DIGSPERLONG];
-       SCM_BIGDIG jdigs[SCM_DIGSPERLONG];
-       scm_longdigs (i, idigs);
-       scm_longdigs (j, jdigs);
-       return scm_mulbig (idigs, SCM_DIGSPERLONG,
-                          jdigs, SCM_DIGSPERLONG,
+       SCM_BIGDIG xdigs [SCM_DIGSPERLONG];
+       SCM_BIGDIG ydigs [SCM_DIGSPERLONG];
+       scm_longdigs (xx, xdigs);
+       scm_longdigs (yy, ydigs);
+       return scm_mulbig (xdigs, SCM_DIGSPERLONG,
+                          ydigs, SCM_DIGSPERLONG,

                           sgn);
 #endif
                           sgn);
 #endif

+#else
+       return scm_make_real (((double) xx) * ((double) yy));
+#endif
+      } else {
+       return k;

       }
       }

+    } else if (SCM_BIGP (y)) {
+#ifndef SCM_DIGSTOOBIG
+      long z = scm_pseudolong (xx);
+      return scm_mulbig ((SCM_BIGDIG *) & z, SCM_DIGSPERLONG,
+                        SCM_BDIGITS (y), SCM_NUMDIGS (y),
+                        SCM_BIGSIGN (y) ? (xx > 0) : (xx < 0));

 #else
 #else

-    return scm_makdbl (((double) i) * ((double) j), 0.0);
+      SCM_BIGDIG zdigs [SCM_DIGSPERLONG];
+      scm_longdigs (xx, zdigs);
+      return scm_mulbig (zdigs, SCM_DIGSPERLONG,
+                        SCM_BDIGITS (y), SCM_NUMDIGS (y),
+                        SCM_BIGSIGN (y) ? (xx > 0) : (xx < 0));

 #endif
 #endif

-    return y;
+    } else if (SCM_REALP (y)) {
+      return scm_make_real (xx * SCM_REAL_VALUE (y));
+    } else if (SCM_COMPLEXP (y)) {
+      return scm_make_complex (xx * SCM_COMPLEX_REAL (y),
+                              xx * SCM_COMPLEX_IMAG (y));
+    } else {
+      SCM_WTA_DISPATCH_2 (g_product, x, y, SCM_ARGn, s_product);
+    }
+  } else if (SCM_BIGP (x)) {
+    if (SCM_INUMP (y)) {
+      SCM_SWAP (x, y);
+      goto intbig;
+    } else if (SCM_BIGP (y)) {
+      return scm_mulbig (SCM_BDIGITS (x), SCM_NUMDIGS (x),
+                        SCM_BDIGITS (y), SCM_NUMDIGS (y),
+                        SCM_BIGSIGN (x) ^ SCM_BIGSIGN (y));
+    } else if (SCM_REALP (y)) {
+      return scm_make_real (scm_big2dbl (x) * SCM_REAL_VALUE (y));
+    } else if (SCM_COMPLEXP (y)) {
+      double z = scm_big2dbl (x);
+      return scm_make_complex (z * SCM_COMPLEX_REAL (y),
+                              z * SCM_COMPLEX_IMAG (y));
+    } else {
+      SCM_WTA_DISPATCH_2 (g_product, x, y, SCM_ARGn, s_product);
+    }
+  } else if (SCM_REALP (x)) {
+    if (SCM_INUMP (y)) {
+      return scm_make_real (SCM_INUM (y) * SCM_REAL_VALUE (x));
+    } else if (SCM_BIGP (y)) {
+      return scm_make_real (scm_big2dbl (y) * SCM_REAL_VALUE (x));
+    } else if (SCM_REALP (y)) {
+      return scm_make_real (SCM_REAL_VALUE (x) * SCM_REAL_VALUE (y));
+    } else if (SCM_COMPLEXP (y)) {
+      return scm_make_complex (SCM_REAL_VALUE (x) * SCM_COMPLEX_REAL (y),
+                              SCM_REAL_VALUE (x) * SCM_COMPLEX_IMAG (y));
+    } else {
+      SCM_WTA_DISPATCH_2 (g_product, x, y, SCM_ARGn, s_product);
+    }
+  } else if (SCM_COMPLEXP (x)) {
+    if (SCM_INUMP (y)) {
+      return scm_make_complex (SCM_INUM (y) * SCM_COMPLEX_REAL (x),
+                              SCM_INUM (y) * SCM_COMPLEX_IMAG (x));
+    } else if (SCM_BIGP (y)) {
+      double z = scm_big2dbl (y);
+      return scm_make_complex (z * SCM_COMPLEX_REAL (x),
+                              z * SCM_COMPLEX_IMAG (x));
+    } else if (SCM_REALP (y)) {
+      return scm_make_complex (SCM_REAL_VALUE (y) * SCM_COMPLEX_REAL (x),
+                              SCM_REAL_VALUE (y) * SCM_COMPLEX_IMAG (x));
+    } else if (SCM_COMPLEXP (y)) {
+      return scm_make_complex (SCM_COMPLEX_REAL (x) * SCM_COMPLEX_REAL (y)
+                              - SCM_COMPLEX_IMAG (x) * SCM_COMPLEX_IMAG (y),
+                              SCM_COMPLEX_REAL (x) * SCM_COMPLEX_IMAG (y)
+                              + SCM_COMPLEX_IMAG (x) * SCM_COMPLEX_REAL (y));
+    } else {
+      SCM_WTA_DISPATCH_2 (g_product, x, y, SCM_ARGn, s_product);
+    }
+  } else {
+    SCM_WTA_DISPATCH_2 (g_product, x, y, SCM_ARG1, s_product);

   }
 }
 
 
   }
 }
 
 

-

 double
 scm_num2dbl (SCM a, const char *why)
 double
 scm_num2dbl (SCM a, const char *why)

+#define FUNC_NAME why

 {
 {

-  if (SCM_INUMP (a))
+  if (SCM_INUMP (a)) {

     return (double) SCM_INUM (a);
     return (double) SCM_INUM (a);

-  SCM_ASSERT (SCM_NIMP (a), a, "wrong type argument", why);
-  if (SCM_SLOPPY_REALP (a))
-    return (SCM_REALPART (a));
-#ifdef SCM_BIGDIG
-  return scm_big2dbl (a);
-#endif
-  SCM_ASSERT (0, a, "wrong type argument", why);
-  /*
-    unreachable, hopefully.
-   */
-  return (double) 0.0;         /* ugh. */
-  /* return SCM_UNSPECIFIED; */
+  } else if (SCM_BIGP (a)) {
+    return scm_big2dbl (a);
+  } else if (SCM_REALP (a)) {
+    return (SCM_REAL_VALUE (a));
+  } else {
+    SCM_WRONG_TYPE_ARG (SCM_ARGn, a);
+  }

 }
 }

+#undef FUNC_NAME

 
 
 SCM_GPROC1 (s_divide, "/", scm_tc7_asubr, scm_divide, g_divide);
 
 
 SCM_GPROC1 (s_divide, "/", scm_tc7_asubr, scm_divide, g_divide);


@@ -3816,177 +3708,157 @@ SCM_GPROC1 (s_divide, "/", scm_tc7_asubr, scm_divide, g_divide);
 SCM
 scm_divide (SCM x, SCM y)
 {
 SCM
 scm_divide (SCM x, SCM y)
 {

-  double d, r, i, a;
-  if (SCM_NINUMP (x))
-    {
-      if (!(SCM_NIMP (x)))
-       {
-         if (SCM_UNBNDP (y))
-           {
-             SCM_GASSERT0 (!SCM_UNBNDP (x),
-                           g_divide, scm_makfrom0str (s_divide), SCM_WNA, 0);
-           badx:
-             SCM_WTA_DISPATCH_1 (g_divide, x, SCM_ARG1, s_divide);
-           }
-         else
-           {
-           badx2:
-             SCM_WTA_DISPATCH_2 (g_divide, x, y, SCM_ARG1, s_divide);
-           }
-       }
-      if (SCM_UNBNDP (y))
-       {
-#ifdef SCM_BIGDIG
-         if (SCM_BIGP (x))
-           return scm_makdbl (1.0 / scm_big2dbl (x), 0.0);
-#endif
-         SCM_ASRTGO (SCM_SLOPPY_INEXACTP (x), badx);
-         if (SCM_SLOPPY_REALP (x))
-           return scm_makdbl (1.0 / SCM_REALPART (x), 0.0);
-         r = SCM_REAL (x);
-         i = SCM_IMAG (x);
-         d = r * r + i * i;
-         return scm_makdbl (r / d, -i / d);
-       }
-#ifdef SCM_BIGDIG
-      if (SCM_BIGP (x))
-       {
-         if (SCM_INUMP (y))
-           {
-             long int z = SCM_INUM (y);
-#ifndef SCM_RECKLESS
-             if (!z)
-               scm_num_overflow (s_divide);
-#endif
-             if (1 == z)
-               return x;
-             if (z < 0)
-               z = -z;
-             if (z < SCM_BIGRAD)
-               {
-                 SCM w = scm_copybig (x, SCM_BIGSIGN (x) ? (y > 0) : (y < 0));
-                 return (scm_divbigdig (SCM_BDIGITS (w), SCM_NUMDIGS (w),
-                                        (SCM_BIGDIG) z)
-                         ? scm_makdbl (scm_big2dbl (x) / SCM_INUM (y), 0.0)
-                         : scm_normbig (w));
-               }
-#ifndef SCM_DIGSTOOBIG
-             /*ugh! Does anyone know what this is supposed to do?*/
-             z = scm_pseudolong (z);
-             z = SCM_INUM(scm_divbigbig (SCM_BDIGITS (x), SCM_NUMDIGS (x),
-                                          (SCM_BIGDIG *) & z, SCM_DIGSPERLONG,
-                                          SCM_BIGSIGN (x) ? (y > 0) : (y < 0), 3));
-#else
-             {
-               SCM_BIGDIG zdigs[SCM_DIGSPERLONG];
-               scm_longdigs (z, zdigs);
-               z = scm_divbigbig (SCM_BDIGITS (x), SCM_NUMDIGS (x),
-                                  zdigs, SCM_DIGSPERLONG,
-                                  SCM_BIGSIGN (x) ? (y > 0) : (y < 0), 3);
-             }
-#endif
-             return z ? SCM_PACK (z) : scm_makdbl (scm_big2dbl (x) / SCM_INUM (y), 0.0);
-           }
-         SCM_ASRTGO (SCM_NIMP (y), bady);
-         if (SCM_BIGP (y))
-           {
-             SCM z = scm_divbigbig (SCM_BDIGITS (x), SCM_NUMDIGS (x),
-                                SCM_BDIGITS (y), SCM_NUMDIGS (y),
-                                SCM_BIGSIGN (x) ^ SCM_BIGSIGN (y), 3);
-             return z ? z : scm_makdbl (scm_big2dbl (x) / scm_big2dbl (y),
-                                        0.0);
-           }
-         SCM_ASRTGO (SCM_SLOPPY_INEXACTP (y), bady);
-         if (SCM_SLOPPY_REALP (y))
-           return scm_makdbl (scm_big2dbl (x) / SCM_REALPART (y), 0.0);
-         a = scm_big2dbl (x);
-         goto complex_div;
-       }
-#endif
-      SCM_ASRTGO (SCM_SLOPPY_INEXACTP (x), badx2);
-      if (SCM_INUMP (y))
-       {
-         d = SCM_INUM (y);
-         goto basic_div;
-       }
+  double a;
+
+  if (SCM_UNBNDP (y)) {
+    if (SCM_UNBNDP (x)) {
+      SCM_WTA_DISPATCH_0 (g_divide, x, SCM_ARG1, s_divide);
+    } else if (SCM_INUMP (x)) {
+      if (SCM_EQ_P (x, SCM_MAKINUM (1L)) || SCM_EQ_P (x, SCM_MAKINUM (-1L))) {
+       return x;
+      } else {
+       return scm_make_real (1.0 / (double) SCM_INUM (x));
+      }
+    } else if (SCM_BIGP (x)) {
+      return scm_make_real (1.0 / scm_big2dbl (x));
+    } else if (SCM_REALP (x)) {
+      return scm_make_real (1.0 / SCM_REAL_VALUE (x));
+    } else if (SCM_COMPLEXP (x)) {
+      double r = SCM_COMPLEX_REAL (x);
+      double i = SCM_COMPLEX_IMAG (x);
+      double d = r * r + i * i;
+      return scm_make_complex (r / d, -i / d);
+    } else {
+      SCM_WTA_DISPATCH_1 (g_divide, x, SCM_ARG1, s_divide);
+    }
+  }
+
+  if (SCM_INUMP (x)) {
+    long xx = SCM_INUM (x);
+    if (SCM_INUMP (y)) {
+      long yy = SCM_INUM (y);
+      if (yy == 0) {
+       scm_num_overflow (s_divide);
+      } else if (xx % yy != 0) {
+       return scm_make_real ((double) xx / (double) yy);
+      } else {
+       long z = xx / yy;
+       if (SCM_FIXABLE (z)) {
+         return SCM_MAKINUM (z);
+       } else {

 #ifdef SCM_BIGDIG
 #ifdef SCM_BIGDIG

-      SCM_ASRTGO (SCM_NIMP (y), bady);
-      if (SCM_BIGP (y))
-       {
-         d = scm_big2dbl (y);
-         goto basic_div;
-       }
-      SCM_ASRTGO (SCM_SLOPPY_INEXACTP (y), bady);
+         return scm_long2big (z);

 #else
 #else

-      SCM_ASRTGO (SCM_SLOPPY_INEXACTP (y), bady);
+         return scm_make_real ((double) xx / (double) yy);

 #endif
 #endif

-      if (SCM_SLOPPY_REALP (y))
-       {
-         d = SCM_REALPART (y);
-       basic_div:
-         return scm_makdbl (SCM_REALPART (x) / d,
-                            SCM_SLOPPY_COMPLEXP (x) ? SCM_IMAG (x) / d : 0.0);

        }
        }

-      a = SCM_REALPART (x);
-      if (SCM_SLOPPY_REALP (x))
-       goto complex_div;
-      r = SCM_REAL (y);
-      i = SCM_IMAG (y);
-      d = r * r + i * i;
-      return scm_makdbl ((a * r + SCM_IMAG (x) * i) / d,
-                        (SCM_IMAG (x) * r - a * i) / d);
-    }
-  if (SCM_UNBNDP (y))
-    {
-      if (SCM_EQ_P (x, SCM_MAKINUM (1L)) || SCM_EQ_P (x, SCM_MAKINUM (-1L)))
-       return x;
-      return scm_makdbl (1.0 / ((double) SCM_INUM (x)), 0.0);
+      }
+    } else if (SCM_BIGP (y)) {
+      return scm_make_real ((double) xx / scm_big2dbl (y));
+    } else if (SCM_REALP (y)) {
+      return scm_make_real ((double) xx / SCM_REAL_VALUE (y));
+    } else if (SCM_COMPLEXP (y)) {
+      a = xx;
+    complex_div: /* y _must_ be a complex number */
+      {
+       double r = SCM_COMPLEX_REAL (y);
+       double i = SCM_COMPLEX_IMAG (y);
+       double d = r * r + i * i;
+       return scm_make_complex ((a * r) / d, (-a * i) / d);
+      }
+    } else {
+      SCM_WTA_DISPATCH_2 (g_divide, x, y, SCM_ARGn, s_divide);

     }
     }

-  if (SCM_NINUMP (y))
-    {
-#ifdef SCM_BIGDIG
-      SCM_ASRTGO (SCM_NIMP (y), bady);
-      if (SCM_BIGP (y))
-       return scm_makdbl (SCM_INUM (x) / scm_big2dbl (y), 0.0);
-      if (!(SCM_SLOPPY_INEXACTP (y)))
-       {
-       bady:
-         SCM_WTA_DISPATCH_2 (g_divide, x, y, SCM_ARGn, s_divide);
-       }
+  } else if (SCM_BIGP (x)) {
+    if (SCM_INUMP (y)) {
+      long int yy = SCM_INUM (y);
+      if (yy == 0) {
+       scm_num_overflow (s_divide);
+      } else if (yy == 1) {
+       return x;
+      } else {
+       long z = yy < 0 ? -yy : yy;
+       if (z < SCM_BIGRAD) {
+         SCM w = scm_copybig (x, SCM_BIGSIGN (x) ? (yy > 0) : (yy < 0));
+         return scm_divbigdig (SCM_BDIGITS (w), SCM_NUMDIGS (w),
+                               (SCM_BIGDIG) z)
+           ? scm_make_real (scm_big2dbl (x) / (double) yy)
+           : scm_normbig (w);
+       } else {
+         SCM w;
+#ifndef SCM_DIGSTOOBIG
+         z = scm_pseudolong (z);
+         w = scm_divbigbig (SCM_BDIGITS (x), SCM_NUMDIGS (x),
+                            (SCM_BIGDIG *) & z, SCM_DIGSPERLONG,
+                            SCM_BIGSIGN (x) ? (yy > 0) : (yy < 0), 3);

 #else
 #else

-      if (!SCM_SLOPPY_INEXACTP (y))
-       {
-       bady:
-         SCM_WTA_DISPATCH_2 (g_divide, x, y, SCM_ARGn, s_divide);
-       }
+         SCM_BIGDIG zdigs[SCM_DIGSPERLONG];
+         scm_longdigs (z, zdigs);
+         w = scm_divbigbig (SCM_BDIGITS (x), SCM_NUMDIGS (x),
+                            zdigs, SCM_DIGSPERLONG,
+                            SCM_BIGSIGN (x) ? (yy > 0) : (yy < 0), 3);

 #endif
 #endif

-      if (SCM_SLOPPY_REALP (y))
-       return scm_makdbl (SCM_INUM (x) / SCM_REALPART (y), 0.0);
-      a = SCM_INUM (x);
-    complex_div:
-      r = SCM_REAL (y);
-      i = SCM_IMAG (y);
-      d = r * r + i * i;
-      return scm_makdbl ((a * r) / d, (-a * i) / d);
+         return (!SCM_UNBNDP (w)) 
+           ? w 
+           : scm_make_real (scm_big2dbl (x) / (double) yy);
+       }
+      }
+    } else if (SCM_BIGP (y)) {
+      SCM w = scm_divbigbig (SCM_BDIGITS (x), SCM_NUMDIGS (x),
+                            SCM_BDIGITS (y), SCM_NUMDIGS (y),
+                            SCM_BIGSIGN (x) ^ SCM_BIGSIGN (y), 3);
+      return (!SCM_UNBNDP (w)) 
+       ? w 
+       : scm_make_real (scm_big2dbl (x) / scm_big2dbl (y));
+    } else if (SCM_REALP (y)) {
+      return scm_make_real (scm_big2dbl (x) / SCM_REAL_VALUE (y));
+    } else if (SCM_COMPLEXP (y)) {
+      a = scm_big2dbl (x);
+      goto complex_div;
+    } else {
+      SCM_WTA_DISPATCH_2 (g_divide, x, y, SCM_ARGn, s_divide);

     }
     }

-  {
-    long z = SCM_INUM (y);
-    if ((0 == z) || SCM_INUM (x) % z)
-      goto ov;
-    z = SCM_INUM (x) / z;
-    if (SCM_FIXABLE (z))
-      return SCM_MAKINUM (z);
-#ifdef SCM_BIGDIG
-    return scm_long2big (z);
-#endif
-  ov:
-    return scm_makdbl (((double) SCM_INUM (x)) / ((double) SCM_INUM (y)), 0.0);
+  } else if (SCM_REALP (x)) {
+    double rx = SCM_REAL_VALUE (x);
+    if (SCM_INUMP (y)) {
+      return scm_make_real (rx / (double) SCM_INUM (y));
+    } else if (SCM_BIGP (y)) {
+      return scm_make_real (rx / scm_big2dbl (y));
+    } else if (SCM_REALP (y)) {
+      return scm_make_real (rx / SCM_REAL_VALUE (y));
+    } else if (SCM_COMPLEXP (y)) {
+      a = rx;
+      goto complex_div;
+    } else {
+      SCM_WTA_DISPATCH_2 (g_divide, x, y, SCM_ARGn, s_divide);
+    }
+  } else if (SCM_COMPLEXP (x)) {
+    double rx = SCM_COMPLEX_REAL (x);
+    double ix = SCM_COMPLEX_IMAG (x);
+    if (SCM_INUMP (y)) {
+      double d = SCM_INUM (y);
+      return scm_make_complex (rx / d, ix / d);
+    } else if (SCM_BIGP (y)) {
+      double d = scm_big2dbl (y);
+      return scm_make_complex (rx / d, ix / d);
+    } else if (SCM_REALP (y)) {
+      double d = SCM_REAL_VALUE (y);
+      return scm_make_complex (rx / d, ix / d);
+    } else if (SCM_COMPLEXP (y)) {
+      double ry = SCM_COMPLEX_REAL (y);
+      double iy = SCM_COMPLEX_IMAG (y);
+      double d = ry * ry + iy * iy;
+      return scm_make_complex ((rx * ry + ix * iy) / d, 
+                              (ix * ry - rx * iy) / d);
+    } else {
+      SCM_WTA_DISPATCH_2 (g_divide, x, y, SCM_ARGn, s_divide);
+    }
+  } else {
+    SCM_WTA_DISPATCH_2 (g_divide, x, y, SCM_ARG1, s_divide);

   }
 }
 
 
   }
 }
 
 

-
-

 SCM_GPROC1 (s_asinh, "$asinh", scm_tc7_cxr, (SCM (*)()) scm_asinh, g_asinh);
 
 double
 SCM_GPROC1 (s_asinh, "$asinh", scm_tc7_cxr, (SCM (*)()) scm_asinh, g_asinh);
 
 double


@@ -4084,70 +3956,40 @@ static void scm_two_doubles (SCM z1,
 static void
 scm_two_doubles (SCM z1, SCM z2, const char *sstring, struct dpair *xy)
 {
 static void
 scm_two_doubles (SCM z1, SCM z2, const char *sstring, struct dpair *xy)
 {

-  if (SCM_INUMP (z1))
+  if (SCM_INUMP (z1)) {

     xy->x = SCM_INUM (z1);
     xy->x = SCM_INUM (z1);

-  else
-    {
-#ifdef SCM_BIGDIG
-      SCM_ASRTGO (SCM_NIMP (z1), badz1);
-      if (SCM_BIGP (z1))
-       xy->x = scm_big2dbl (z1);
-      else
-       {
-#ifndef SCM_RECKLESS
-         if (!SCM_SLOPPY_REALP (z1))
-           badz1:scm_wta (z1, (char *) SCM_ARG1, sstring);
-#endif
-         xy->x = SCM_REALPART (z1);
-       }
-#else
-      {
-       SCM_ASSERT (SCM_SLOPPY_REALP (z1), z1, SCM_ARG1, sstring);
-       xy->x = SCM_REALPART (z1);
-      }
-#endif
-    }
-  if (SCM_INUMP (z2))
+  } else if (SCM_BIGP (z1)) {
+    xy->x = scm_big2dbl (z1);
+  } else if (SCM_REALP (z1)) {
+    xy->x = SCM_REAL_VALUE (z1);
+  } else {
+    scm_wrong_type_arg (sstring, SCM_ARG1, z1);
+  }
+
+  if (SCM_INUMP (z2)) {

     xy->y = SCM_INUM (z2);
     xy->y = SCM_INUM (z2);

-  else
-    {
-#ifdef SCM_BIGDIG
-      SCM_ASRTGO (SCM_NIMP (z2), badz2);
-      if (SCM_BIGP (z2))
-       xy->y = scm_big2dbl (z2);
-      else
-       {
-#ifndef SCM_RECKLESS
-         if (!(SCM_SLOPPY_REALP (z2)))
-           badz2:scm_wta (z2, (char *) SCM_ARG2, sstring);
-#endif
-         xy->y = SCM_REALPART (z2);
-       }
-#else
-      {
-       SCM_ASSERT (SCM_SLOPPY_REALP (z2), z2, SCM_ARG2, sstring);
-       xy->y = SCM_REALPART (z2);
-      }
-#endif
-    }
+  } else if (SCM_BIGP (z2)) {
+    xy->y = scm_big2dbl (z2);
+  } else if (SCM_REALP (z2)) {
+    xy->y = SCM_REAL_VALUE (z2);
+  } else {
+    scm_wrong_type_arg (sstring, SCM_ARG2, z2);
+  }

 }
 
 
 }
 
 

-
-

 SCM_DEFINE (scm_sys_expt, "$expt", 2, 0, 0,
             (SCM z1, SCM z2),
 SCM_DEFINE (scm_sys_expt, "$expt", 2, 0, 0,
             (SCM z1, SCM z2),

-           "")
+           "") 

 #define FUNC_NAME s_scm_sys_expt
 {
   struct dpair xy;
   scm_two_doubles (z1, z2, FUNC_NAME, &xy);
 #define FUNC_NAME s_scm_sys_expt
 {
   struct dpair xy;
   scm_two_doubles (z1, z2, FUNC_NAME, &xy);

-  return scm_makdbl (pow (xy.x, xy.y), 0.0);
+  return scm_make_real (pow (xy.x, xy.y));

 }
 #undef FUNC_NAME
 
 
 }
 #undef FUNC_NAME
 
 

-

 SCM_DEFINE (scm_sys_atan2, "$atan2", 2, 0, 0,
             (SCM z1, SCM z2),
            "")
 SCM_DEFINE (scm_sys_atan2, "$atan2", 2, 0, 0,
             (SCM z1, SCM z2),
            "")


@@ -4155,20 +3997,20 @@ SCM_DEFINE (scm_sys_atan2, "$atan2", 2, 0, 0,
 {
   struct dpair xy;
   scm_two_doubles (z1, z2, FUNC_NAME, &xy);
 {
   struct dpair xy;
   scm_two_doubles (z1, z2, FUNC_NAME, &xy);

-  return scm_makdbl (atan2 (xy.x, xy.y), 0.0);
+  return scm_make_real (atan2 (xy.x, xy.y));

 }
 #undef FUNC_NAME
 
 
 }
 #undef FUNC_NAME
 
 

-

 SCM_DEFINE (scm_make_rectangular, "make-rectangular", 2, 0, 0,
 SCM_DEFINE (scm_make_rectangular, "make-rectangular", 2, 0, 0,

-            (SCM z1, SCM z2),
-           "")
+            (SCM real, SCM imaginary),
+           "Return a complex number constructed of the given REAL and\n"
+           "IMAGINARY parts.")

 #define FUNC_NAME s_scm_make_rectangular
 {
   struct dpair xy;
 #define FUNC_NAME s_scm_make_rectangular
 {
   struct dpair xy;

-  scm_two_doubles (z1, z2, FUNC_NAME, &xy);
-  return scm_makdbl (xy.x, xy.y);
+  scm_two_doubles (real, imaginary, FUNC_NAME, &xy);
+  return scm_make_complex (xy.x, xy.y);

 }
 #undef FUNC_NAME
 
 }
 #undef FUNC_NAME
 


@@ -4176,184 +4018,145 @@ SCM_DEFINE (scm_make_rectangular, "make-rectangular", 2, 0, 0,
 
 SCM_DEFINE (scm_make_polar, "make-polar", 2, 0, 0,
             (SCM z1, SCM z2),
 
 SCM_DEFINE (scm_make_polar, "make-polar", 2, 0, 0,
             (SCM z1, SCM z2),

-           "")
+           "Return the complex number Z1 * e^(i * Z2).")

 #define FUNC_NAME s_scm_make_polar
 {
   struct dpair xy;
   scm_two_doubles (z1, z2, FUNC_NAME, &xy);
 #define FUNC_NAME s_scm_make_polar
 {
   struct dpair xy;
   scm_two_doubles (z1, z2, FUNC_NAME, &xy);

-  return scm_makdbl (xy.x * cos (xy.y), xy.x * sin (xy.y));
+  return scm_make_complex (xy.x * cos (xy.y), xy.x * sin (xy.y));

 }
 #undef FUNC_NAME
 
 
 }
 #undef FUNC_NAME
 
 

-
-

 SCM_GPROC (s_real_part, "real-part", 1, 0, 0, scm_real_part, g_real_part);
 
 SCM
 scm_real_part (SCM z)
 {
 SCM_GPROC (s_real_part, "real-part", 1, 0, 0, scm_real_part, g_real_part);
 
 SCM
 scm_real_part (SCM z)
 {

-  if (SCM_NINUMP (z))
-    {
-#ifdef SCM_BIGDIG
-      SCM_ASRTGO (SCM_NIMP (z), badz);
-      if (SCM_BIGP (z))
-       return z;
-      if (!(SCM_SLOPPY_INEXACTP (z)))
-       {
-       badz:
-         SCM_WTA_DISPATCH_1 (g_real_part, z, SCM_ARG1, s_real_part);
-       }
-#else
-      SCM_GASSERT1 (SCM_SLOPPY_INEXACTP (z),
-                   g_real_part, z, SCM_ARG1, s_real_part);
-#endif
-      if (SCM_SLOPPY_COMPLEXP (z))
-       return scm_makdbl (SCM_REAL (z), 0.0);
-    }
-  return z;
+  if (SCM_INUMP (z)) {
+    return z;
+  } else if (SCM_BIGP (z)) {
+    return z;
+  } else if (SCM_REALP (z)) {
+    return z;
+  } else if (SCM_COMPLEXP (z)) {
+    return scm_make_real (SCM_COMPLEX_REAL (z));
+  } else {
+    SCM_WTA_DISPATCH_1 (g_real_part, z, SCM_ARG1, s_real_part);
+  }

 }
 
 
 }
 
 

-

 SCM_GPROC (s_imag_part, "imag-part", 1, 0, 0, scm_imag_part, g_imag_part);
 
 SCM
 scm_imag_part (SCM z)
 {
 SCM_GPROC (s_imag_part, "imag-part", 1, 0, 0, scm_imag_part, g_imag_part);
 
 SCM
 scm_imag_part (SCM z)
 {

-  if (SCM_INUMP (z))
+  if (SCM_INUMP (z)) {

     return SCM_INUM0;
     return SCM_INUM0;

-#ifdef SCM_BIGDIG
-  SCM_ASRTGO (SCM_NIMP (z), badz);
-  if (SCM_BIGP (z))
+  } else if (SCM_BIGP (z)) {

     return SCM_INUM0;
     return SCM_INUM0;

-  if (!(SCM_SLOPPY_INEXACTP (z)))
-    {
-    badz:
-      SCM_WTA_DISPATCH_1 (g_imag_part, z, SCM_ARG1, s_imag_part);
-    }
-#else
-  SCM_GASSERT1 (SCM_SLOPPY_INEXACTP (z),
-               g_imag_part, z, SCM_ARG1, s_imag_part);
-#endif
-  if (SCM_SLOPPY_COMPLEXP (z))
-    return scm_makdbl (SCM_IMAG (z), 0.0);
-  return scm_flo0;
+  } else if (SCM_REALP (z)) {
+    return scm_flo0;
+  } else if (SCM_COMPLEXP (z)) {
+    return scm_make_real (SCM_COMPLEX_IMAG (z));
+  } else {
+    SCM_WTA_DISPATCH_1 (g_imag_part, z, SCM_ARG1, s_imag_part);
+  }

 }
 
 
 }
 
 

-

 SCM_GPROC (s_magnitude, "magnitude", 1, 0, 0, scm_magnitude, g_magnitude);
 
 SCM
 scm_magnitude (SCM z)
 {
 SCM_GPROC (s_magnitude, "magnitude", 1, 0, 0, scm_magnitude, g_magnitude);
 
 SCM
 scm_magnitude (SCM z)
 {

-  if (SCM_INUMP (z))
-    return scm_abs (z);
+  if (SCM_INUMP (z)) {
+    long int zz = SCM_INUM (z);
+    if (zz >= 0) {
+      return z;
+    } else if (SCM_POSFIXABLE (-zz)) {
+      return SCM_MAKINUM (-zz);
+    } else {

 #ifdef SCM_BIGDIG
 #ifdef SCM_BIGDIG

-  SCM_ASRTGO (SCM_NIMP (z), badz);
-  if (SCM_BIGP (z))
-    return scm_abs (z);
-  if (!(SCM_SLOPPY_INEXACTP (z)))
-    {
-    badz:
-      SCM_WTA_DISPATCH_1 (g_magnitude, z, SCM_ARG1, s_magnitude);
-    }
+      return scm_long2big (-zz);

 #else
 #else

-  SCM_GASSERT1 (SCM_SLOPPY_INEXACTP (z),
-               g_magnitude, z, SCM_ARG1, s_magnitude);
+      scm_num_overflow (s_magnitude);

 #endif
 #endif

-  if (SCM_SLOPPY_COMPLEXP (z))
-    {
-      double i = SCM_IMAG (z), r = SCM_REAL (z);
-      return scm_makdbl (sqrt (i * i + r * r), 0.0);

     }
     }

-  return scm_makdbl (fabs (SCM_REALPART (z)), 0.0);
+  } else if (SCM_BIGP (z)) {
+    if (!SCM_BIGSIGN (z)) {
+      return z;
+    } else {
+      return scm_copybig (z, 0);
+    }
+  } else if (SCM_REALP (z)) {
+    return scm_make_real (fabs (SCM_REAL_VALUE (z)));
+  } else if (SCM_COMPLEXP (z)) {
+    double r = SCM_COMPLEX_REAL (z);
+    double i = SCM_COMPLEX_IMAG (z);
+    return scm_make_real (sqrt (i * i + r * r));
+  } else {
+    SCM_WTA_DISPATCH_1 (g_magnitude, z, SCM_ARG1, s_magnitude);
+  }

 }
 
 
 }
 
 

-
-

 SCM_GPROC (s_angle, "angle", 1, 0, 0, scm_angle, g_angle);
 
 SCM
 scm_angle (SCM z)
 {
 SCM_GPROC (s_angle, "angle", 1, 0, 0, scm_angle, g_angle);
 
 SCM
 scm_angle (SCM z)
 {

-  double x, y = 0.0;
-  if (SCM_INUMP (z))
-    {
-      x = (z >= SCM_INUM0) ? 1.0 : -1.0;
-      goto do_angle;
-    }
-#ifdef SCM_BIGDIG
-  SCM_ASRTGO (SCM_NIMP (z), badz);
-  if (SCM_BIGP (z))
-    {
-      x = (SCM_BIGSIGN (z)) ? -1.0 : 1.0;
-      goto do_angle;
-    }
-  if (!(SCM_SLOPPY_INEXACTP (z)))
-    {
-    badz:
-      SCM_WTA_DISPATCH_1 (g_angle, z, SCM_ARG1, s_angle);
+  if (SCM_INUMP (z)) {
+    if (SCM_INUM (z) >= 0) {
+      return scm_make_real (atan2 (0.0, 1.0));
+    } else {
+      return scm_make_real (atan2 (0.0, -1.0));

     }
     }

-#else
-  SCM_GASSERT1 (SCM_SLOPPY_INEXACTP (z), g_angle, z, SCM_ARG1, s_angle);
-#endif
-  if (SCM_SLOPPY_REALP (z))
-    {
-      x = SCM_REALPART (z);
-      goto do_angle;
+  } else if (SCM_BIGP (z)) {
+    if (SCM_BIGSIGN (z)) {
+      return scm_make_real (atan2 (0.0, -1.0));
+    } else {
+      return scm_make_real (atan2 (0.0, 1.0));

     }
     }

-  x = SCM_REAL (z);
-  y = SCM_IMAG (z);
- do_angle:
-  return scm_makdbl (atan2 (y, x), 0.0);
+  } else if (SCM_REALP (z)) {
+    return scm_make_real (atan2 (0.0, SCM_REAL_VALUE (z)));
+  } else if (SCM_COMPLEXP (z)) {
+    return scm_make_real (atan2 (SCM_COMPLEX_IMAG (z), SCM_COMPLEX_REAL (z)));
+  } else {
+    SCM_WTA_DISPATCH_1 (g_angle, z, SCM_ARG1, s_angle);
+  }

 }
 
 
 SCM_DEFINE (scm_inexact_to_exact, "inexact->exact", 1, 0, 0, 
             (SCM z),
 }
 
 
 SCM_DEFINE (scm_inexact_to_exact, "inexact->exact", 1, 0, 0, 
             (SCM z),

-           "")
+           "Returns an exact number that is numerically closest to Z.")

 #define FUNC_NAME s_scm_inexact_to_exact
 {
 #define FUNC_NAME s_scm_inexact_to_exact
 {

-  if (SCM_INUMP (z))
+  if (SCM_INUMP (z)) {

     return z;
     return z;

-#ifdef SCM_BIGDIG
-  SCM_ASRTGO (SCM_NIMP (z), badz);
-  if (SCM_BIGP (z))
+  } else if (SCM_BIGP (z)) {

     return z;
     return z;

-#ifndef SCM_RECKLESS
-  if (!(SCM_SLOPPY_REALP (z)))
-    {
-    badz:
-      SCM_WTA (1, z);
-    }
-#endif
-#else
-  SCM_VALIDATE_REAL (1,z);
-#endif
+  } else if (SCM_REALP (z)) {
+    double u = floor (SCM_REAL_VALUE (z) + 0.5);
+    long lu = (long) u;
+    if (SCM_FIXABLE (lu)) {
+      return SCM_MAKINUM (lu);

 #ifdef SCM_BIGDIG
 #ifdef SCM_BIGDIG

-  {
-    double u = floor (SCM_REALPART (z) + 0.5);
-    if ((u <= SCM_MOST_POSITIVE_FIXNUM) && (-u <= -SCM_MOST_NEGATIVE_FIXNUM))
-      {
-       /* Negation is a workaround for HP700 cc bug */
-       SCM ans = SCM_MAKINUM ((long) u);
-       if (SCM_INUM (ans) == (long) u)
-         return ans;
-      }
-    SCM_ASRTGO (isfinite (u), badz);   /* problem? */
-    return scm_dbl2big (u);
-  }
-#else
-  return SCM_MAKINUM ((long) floor (SCM_REALPART (z) + 0.5));
+    } else if (isfinite (u)) {
+      return scm_dbl2big (u);

 #endif
 #endif

+    } else {
+      scm_num_overflow (s_scm_inexact_to_exact);
+    }
+  } else {
+    SCM_WRONG_TYPE_ARG (1, z);
+  }

 }
 #undef FUNC_NAME
 
 
 }
 #undef FUNC_NAME
 
 

-

 #ifdef SCM_BIGDIG
 /* d must be integer */
 
 #ifdef SCM_BIGDIG
 /* d must be integer */
 


@@ -4411,7 +4214,7 @@ scm_long2num (long sl)
 #ifdef SCM_BIGDIG
       return scm_long2big (sl);
 #else
 #ifdef SCM_BIGDIG
       return scm_long2big (sl);
 #else

-      return scm_makdbl ((double) sl, 0.0);
+      return scm_make_real ((double) sl);

 #endif
     }
   return SCM_MAKINUM (sl);
 #endif
     }
   return SCM_MAKINUM (sl);


@@ -4428,7 +4231,7 @@ scm_long_long2num (long_long sl)
 #ifdef SCM_BIGDIG
       return scm_long_long2big (sl);
 #else
 #ifdef SCM_BIGDIG
       return scm_long_long2big (sl);
 #else

-      return scm_makdbl ((double) sl, 0.0);
+      return scm_make_real ((double) sl);

 #endif
     }
   else
 #endif
     }
   else


@@ -4437,8 +4240,8 @@ scm_long_long2num (long_long sl)
       return SCM_MAKINUM ((scm_bits_t) sl);
     }
 }
       return SCM_MAKINUM ((scm_bits_t) sl);
     }
 }

-#endif

 
 

+#endif /* HAVE_LONG_LONGS */

 
 
 SCM
 
 
 SCM


@@ -4449,7 +4252,7 @@ scm_ulong2num (unsigned long sl)
 #ifdef SCM_BIGDIG
       return scm_ulong2big (sl);
 #else
 #ifdef SCM_BIGDIG
       return scm_ulong2big (sl);
 #else

-      return scm_makdbl ((double) sl, 0.0);
+      return scm_make_real ((double) sl);

 #endif
     }
   return SCM_MAKINUM (sl);
 #endif
     }
   return SCM_MAKINUM (sl);


@@ -4459,204 +4262,181 @@ scm_ulong2num (unsigned long sl)
 long
 scm_num2long (SCM num, char *pos, const char *s_caller)
 {
 long
 scm_num2long (SCM num, char *pos, const char *s_caller)
 {

-  long res;
-
-  if (SCM_INUMP (num))
-    {
-      res = SCM_INUM (num);
-      return res;
+  if (SCM_INUMP (num)) {
+    return SCM_INUM (num);
+  } else if (SCM_BIGP (num)) {
+    long int res;
+    /* can't use res directly in case num is -2^31.  */
+    unsigned long int pos_res = 0;
+    unsigned long int old_res = 0;
+    scm_sizet l;
+
+    for (l = SCM_NUMDIGS (num); l--;) {
+      pos_res = SCM_BIGUP (pos_res) + SCM_BDIGITS (num)[l];
+      if (pos_res >= old_res) {
+       old_res = pos_res;
+      } else {
+       /* overflow. */
+       scm_out_of_range (s_caller, num);
+      }

     }
     }

-  SCM_ASRTGO (SCM_NIMP (num), wrong_type_arg);
-  if (SCM_SLOPPY_REALP (num))
-    {
-      volatile double u = SCM_REALPART (num);
-
-      res = u;
-      if (res != u)
-       goto out_of_range;
-      return res;
+    if (SCM_BIGSIGN (num)) {
+      res = -pos_res;
+      if (res <= 0) {
+       return res;
+      } else {
+       scm_out_of_range (s_caller, num);
+      }
+    } else {
+      res = pos_res;
+      if (res >= 0) {
+       return res;
+      } else {
+       scm_out_of_range (s_caller, num);
+      }

     }
     }

-#ifdef SCM_BIGDIG
-  if (SCM_BIGP (num))
-    {
-      unsigned long oldres = 0;
-      scm_sizet l;
-      /* can't use res directly in case num is -2^31.  */
-      unsigned long pos_res = 0;
-
-      for (l = SCM_NUMDIGS (num); l--;)
-       {
-         pos_res = SCM_BIGUP (pos_res) + SCM_BDIGITS (num)[l];
-         /* check for overflow.  */
-         if (pos_res < oldres) 
-           goto out_of_range;
-         oldres = pos_res;
-       }
-      if (SCM_BIGSIGN (num))
-       {
-         res = - pos_res;
-         if (res > 0)
-           goto out_of_range;
-       }
-      else
-       {
-         res = pos_res;
-         if (res < 0)
-           goto out_of_range;
-       }
+  } else if (SCM_REALP (num)) {
+    double u = SCM_REAL_VALUE (num);
+    long int res = u;
+    if ((double) res == u) {

       return res;
       return res;

+    } else {
+      scm_out_of_range (s_caller, num);

     }
     }

-#endif
- wrong_type_arg:
-  scm_wrong_type_arg (s_caller, (int) pos, num);
- out_of_range:
-  scm_out_of_range (s_caller, num);
+  } else {
+    scm_wrong_type_arg (s_caller, (int) pos, num);
+  }

 }
 
 
 }
 
 

-

 #ifdef HAVE_LONG_LONGS
 
 long_long
 scm_num2long_long (SCM num, char *pos, const char *s_caller)
 {
 #ifdef HAVE_LONG_LONGS
 
 long_long
 scm_num2long_long (SCM num, char *pos, const char *s_caller)
 {

-  long_long res;
-
-  if (SCM_INUMP (num))
-    {
-      res = SCM_INUM (num);
-      return res;
+  if (SCM_INUMP (num)) {
+    return SCM_INUM (num);
+  } else if (SCM_BIGP (num)) {
+    long long res;
+    /* can't use res directly in case num is -2^63.  */
+    unsigned long long int pos_res = 0;
+    unsigned long long int old_res = 0;
+    scm_sizet l;
+
+    for (l = SCM_NUMDIGS (num); l--;) {
+      pos_res = SCM_LONGLONGBIGUP (pos_res) + SCM_BDIGITS (num)[l];
+      if (pos_res >= old_res) {
+       old_res = pos_res;
+      } else {
+       /* overflow. */
+       scm_out_of_range (s_caller, num);
+      }

     }
     }

-  SCM_ASRTGO (SCM_NIMP (num), wrong_type_arg);
-  if (SCM_SLOPPY_REALP (num))
-    {
-      double u = SCM_REALPART (num);
-
-      res = u;
-      if ((res < 0 && u > 0) || (res > 0 && u < 0)) /* check for overflow. */
-       goto out_of_range;
-
-      return res;
+    if (SCM_BIGSIGN (num)) {
+      res = -pos_res;
+      if (res <= 0) {
+       return res;
+      } else {
+       scm_out_of_range (s_caller, num);
+      }
+    } else {
+      res = pos_res;
+      if (res >= 0) {
+       return res;
+      } else {
+       scm_out_of_range (s_caller, num);
+      }

     }
     }

-#ifdef SCM_BIGDIG
-  if (SCM_BIGP (num))
-    {
-      unsigned long long oldres = 0;
-      scm_sizet l;
-      /* can't use res directly in case num is -2^63.  */
-      unsigned long long pos_res = 0;
-
-      for (l = SCM_NUMDIGS (num); l--;)
-       {
-         pos_res = SCM_LONGLONGBIGUP (pos_res) + SCM_BDIGITS (num)[l];
-         /* check for overflow.  */
-         if (pos_res < oldres) 
-           goto out_of_range;
-         oldres = pos_res;
-       }
-      if (SCM_BIGSIGN (num))
-       {
-         res = - pos_res;
-         if (res > 0)
-           goto out_of_range;
-       }
-      else
-       {
-         res = pos_res;
-         if (res < 0)
-           goto out_of_range;
-       }
+  } else if (SCM_REALP (num)) {
+    double u = SCM_REAL_VALUE (num);
+    long long int res = u;
+    if ((double) res == u) {

       return res;
       return res;

+    } else {
+      scm_out_of_range (s_caller, num);

     }
     }

-#endif
- wrong_type_arg:
-  scm_wrong_type_arg (s_caller, (int) pos, num);
- out_of_range:
-  scm_out_of_range (s_caller, num);
+  } else {
+    scm_wrong_type_arg (s_caller, (int) pos, num);
+  }

 }
 }

-#endif

 
 

+#endif /* HAVE_LONG_LONGS */

 
 
 unsigned long
 scm_num2ulong (SCM num, char *pos, const char *s_caller)
 {
 
 
 unsigned long
 scm_num2ulong (SCM num, char *pos, const char *s_caller)
 {

-  unsigned long res;
-
-  if (SCM_INUMP (num))
-    {
-      if (SCM_INUM (num) < 0)
-       goto out_of_range;
-      res = SCM_INUM (num);
-      return res;
+  if (SCM_INUMP (num)) {
+    long nnum = SCM_INUM (num);
+    if (nnum >= 0) {
+      return nnum;
+    } else {
+      scm_out_of_range (s_caller, num);

     }
     }

-  SCM_ASRTGO (SCM_NIMP (num), wrong_type_arg);
-  if (SCM_SLOPPY_REALP (num))
-    {
-      double u = SCM_REALPART (num);
-
-      res = u;
-      if (res != u)
-       goto out_of_range;
-      return res;
+  } else if (SCM_BIGP (num)) {
+    unsigned long int res = 0;
+    unsigned long int old_res = 0;
+    scm_sizet l;
+    
+    for (l = SCM_NUMDIGS (num); l--;) {
+      res = SCM_BIGUP (res) + SCM_BDIGITS (num)[l];
+      if (res >= old_res) {
+       old_res = res;
+      } else {
+       scm_out_of_range (s_caller, num);
+      }

     }
     }

-#ifdef SCM_BIGDIG
-  if (SCM_BIGP (num))
-    {
-      unsigned long oldres = 0;
-      scm_sizet l;
-
-      res = 0;
-      for (l = SCM_NUMDIGS (num); l--;)
-       {
-         res = SCM_BIGUP (res) + SCM_BDIGITS (num)[l];
-         if (res < oldres)
-           goto out_of_range;
-         oldres = res;
-       }
+    return res;
+  } else if (SCM_REALP (num)) {
+    double u = SCM_REAL_VALUE (num);
+    unsigned long int res = u;
+    if ((double) res == u) {

       return res;
       return res;

+    } else {
+      scm_out_of_range (s_caller, num);

     }
     }

-#endif
- wrong_type_arg:
-  scm_wrong_type_arg (s_caller, (int) pos, num);
- out_of_range:
-  scm_out_of_range (s_caller, num);
-}
-
-
-#ifndef DBL_DIG
-static void
-add1 (double f, double *fsum)
-{
-  *fsum = f + 1.0;
+  } else {
+    scm_wrong_type_arg (s_caller, (int) pos, num);
+  }

 }
 }

-#endif
-

 
 
 void
 scm_init_numbers ()
 {
 
 
 void
 scm_init_numbers ()
 {

+  abs_most_negative_fixnum = scm_long2big (- SCM_MOST_NEGATIVE_FIXNUM);
+  scm_permanent_object (abs_most_negative_fixnum);
+
+  /* It may be possible to tune the performance of some algorithms by using
+   * the following constants to avoid the creation of bignums.  Please, before
+   * using these values, remember the two rules of program optimization:
+   * 1st Rule:  Don't do it.  2nd Rule (experts only):  Don't do it yet. */
+  scm_sysintern ("most-positive-fixnum", SCM_MAKINUM (SCM_MOST_POSITIVE_FIXNUM));
+  scm_sysintern ("most-negative-fixnum", SCM_MAKINUM (SCM_MOST_NEGATIVE_FIXNUM));
+

   scm_add_feature ("complex");
   scm_add_feature ("inexact");
   scm_add_feature ("complex");
   scm_add_feature ("inexact");

-  SCM_NEWREAL (scm_flo0, 0.0);
+  scm_flo0 = scm_make_real (0.0);

 #ifdef DBL_DIG
   scm_dblprec = (DBL_DIG > 20) ? 20 : DBL_DIG;
 #else
   {                            /* determine floating point precision */
     double f = 0.1;
     double fsum = 1.0 + f;
 #ifdef DBL_DIG
   scm_dblprec = (DBL_DIG > 20) ? 20 : DBL_DIG;
 #else
   {                            /* determine floating point precision */
     double f = 0.1;
     double fsum = 1.0 + f;

-    while (fsum != 1.0)
-      {
+    while (fsum != 1.0) {
+      if (++scm_dblprec > 20) {
+       fsum = 1.0;
+      } else {

        f /= 10.0;
        f /= 10.0;

-       if (++scm_dblprec > 20)
-         break;
-       add1 (f, &fsum);
+       fsum = f + 1.0;

       }
       }

+    }

     scm_dblprec = scm_dblprec - 1;
   }
 #endif /* DBL_DIG */
     scm_dblprec = scm_dblprec - 1;
   }
 #endif /* DBL_DIG */

+#ifndef SCM_MAGIC_SNARFER

 #include "libguile/numbers.x"
 #include "libguile/numbers.x"

+#endif

 }
 
 /*
 }
 
 /*