Import Upstream version 5d9upstream/5d9

1 files changed, 114 insertions, 109 deletions

diff --git a/scl.c b/scl.c
index 57d020e..13f6023 100644
--- a/scl.c
+++ b/scl.c
@@ -74,8 +74,9 @@ sizet num_protects = NUM_PROTECTS;
 char		s_inexactp[] = "inexact?";
 static char     s_zerop[] = "zero?",
 		s_positivep[] = "positive?", s_negativep[] = "negative?";
-static char     s_eqp[] = "=", s_lessp[] = "<", s_grp[] = ">";
+static char     s_lessp[] = "<", s_grp[] = ">";
 static char     s_leqp[] = "<=", s_greqp[] = ">=";
+#define s_eqp (&s_leqp[1])
 static char     s_max[] = "max", s_min[] = "min";
 char		s_sum[] = "+", s_difference[] = "-", s_product[] = "*",
 		s_divide[] = "/";
@@ -91,9 +92,6 @@ static char s_intexpt[] = "integer-expt";
 
 /*** NUMBERS -> STRINGS ***/
 #ifdef FLOATS
-# ifndef DBL_MANT_DIG
-#  define DBL_MANT_DIG dbl_mant_dig
-# endif
 static int dbl_mant_dig = 0;
 static double max_dbl_int;       /* Integers less than or equal to max_dbl_int
 				    are representable exactly as doubles. */
@@ -105,10 +103,10 @@ double dbl_prec(x)
   double frac = frexp(x, &expt);
 # ifdef DBL_MIN_EXP
   if (0.0==x || expt < DBL_MIN_EXP) /* gradual underflow */
-    return ldexp(1.0, -DBL_MANT_DIG) * ldexp(1.0, DBL_MIN_EXP);
+    return ldexp(1.0, - dbl_mant_dig) * ldexp(1.0, DBL_MIN_EXP);
 # endif
-  if (1.0==frac) return ldexp(1.0, expt - DBL_MANT_DIG + 1);
-  return ldexp(1.0, expt - DBL_MANT_DIG);
+  if (1.0==frac) return ldexp(1.0, expt - dbl_mant_dig + 1);
+  return ldexp(1.0, expt - dbl_mant_dig);
 }
 
 static double llog2 = 0.3010299956639812; /* log10(2) */
@@ -142,6 +140,17 @@ static double lpow10(x, n)
   return x/p10[-n];
 }
 
+int NaN2str(f, a)
+     double f;
+     char *a;
+{
+  sizet ch = 0;
+  if (f < 0.0) a[ch++] = '-';
+  a[ch++] = IS_INF(f)?'1':'0';
+  a[ch++] = '/'; a[ch++] = '0';
+  return ch;
+}
+
 /* DBL2STR_FUZZ is a somewhat arbitrary guard against
    round off error in scaling f and fprec. */
 # define DBL2STR_FUZZ 0.9
@@ -155,13 +164,10 @@ static sizet idbl2str(f, a)
   sizet ch = 0;
 
   if (f==0.0) {exp = 0; goto zero;}	/*{a[0]='0'; a[1]='.'; a[2]='0'; return 3;}*/
+  if IS_INF(f) return NaN2str(f, a);
   if (f < 0.0) {f = -f;a[ch++]='-';}
   else if (f > 0.0) ;
-  else goto funny;
-  if IS_INF(f) {
-    if (ch==0) a[ch++]='+';
-  funny: a[ch++]='#'; a[ch++]='.'; a[ch++]='#'; return ch;
-  }
+  else return NaN2str(f, a);
   exp = apx_log10(f);
   f = lpow10(f, -exp);
   fprec = lpow10(fprec, -exp);
@@ -171,12 +177,13 @@ static sizet idbl2str(f, a)
   while (f < 1.0) {
     f *= 10.0;
     fprec *= 10.0;
-    if (exp-- < DBL_MIN_10_EXP - DBL_DIG - 1) goto funny;
+    if (exp-- < DBL_MIN_10_EXP - DBL_DIG - 1) return NaN2str(f, a);
   }
   while (f > 10.0) {
     f /= 10.0;
     fprec /= 10.0;
-    if (exp++ > DBL_MAX_10_EXP) goto funny;}
+    if (exp++ > DBL_MAX_10_EXP) return NaN2str(f, a);
+  }
 # else
   while (f < 1.0) {f *= 10.0; fprec *= 10.0; exp--;}
   while (f > 10.0) {f /= 10.0; fprec /= 10.0; exp++;}
@@ -258,8 +265,7 @@ static sizet iflo2str(flt, str)
 # endif
     i = idbl2str(REAL(flt), str);
   if CPLXP(flt) {
-              if(0 <= IMAG(flt)) /* jeh */
-                str[i++] = '+'; /* jeh */
+    if (!(0 > IMAG(flt))) str[i++] = '+';
     i += idbl2str(IMAG(flt), &str[i]);
     str[i++] = 'i';
   }
@@ -340,7 +346,7 @@ SCM number2string(x, radix)
      SCM x, radix;
 {
   if UNBNDP(radix) radix=MAKINUM(10L);
-  else ASSERT(INUMP(radix), radix, ARG2, s_number2string);
+  else ASRTER(INUMP(radix), radix, ARG2, s_number2string);
 #ifdef FLOATS
   if NINUMP(x) {
     char num_buf[FLOBUFLEN];
@@ -352,18 +358,18 @@ SCM number2string(x, radix)
     badx: wta(x, (char *)ARG1, s_number2string);
 #  endif
 # else
-    ASSERT(NIMP(x) && INEXP(x), x, ARG1, s_number2string);
+    ASRTER(NIMP(x) && INEXP(x), x, ARG1, s_number2string);
 # endif
     return makfromstr(num_buf, iflo2str(x, num_buf));
   }
 #else
 # ifdef BIGDIG
   if NINUMP(x) {
-    ASSERT(NIMP(x) && BIGP(x), x, ARG1, s_number2string);
+    ASRTER(NIMP(x) && BIGP(x), x, ARG1, s_number2string);
     return big2str(x, (unsigned int)INUM(radix));
   }
 # else
-  ASSERT(INUMP(x), x, ARG1, s_number2string);
+  ASRTER(INUMP(x), x, ARG1, s_number2string);
 # endif
 #endif
   {
@@ -451,7 +457,7 @@ SCM istr2int(str, len, radix)
 	ds[k++] = BIGLO(t2);
 	t2 = BIGDN(t2);
       }
-      ASSERT(blen <= j, (SCM)MAKINUM(blen), OVFLOW, "bignum");
+      ASRTER(blen <= j, (SCM)MAKINUM(blen), OVFLOW, "bignum");
       if (t2) {blen++; goto moretodo;}
       break;
     default:
@@ -630,7 +636,7 @@ SCM istr2flo(str, len, radix)
       }
     }
   out2:
-    if (tmp==0.0) return BOOL_F; /* `slash zero' not allowed */
+/*     if (tmp==0.0) return BOOL_F; /\* `slash zero' not allowed *\/ */
     if (i < len)
       while (str[i]=='#') {	/* optional sharps */
 	tmp *= radix;
@@ -679,9 +685,9 @@ SCM istr2flo(str, len, radix)
       switch (c = str[i]) {
       case DIGITS:
 	expon = expon*10 + c-'0';
-	if (expon > MAXEXP)
-	  if (1==expsgn || expon > (MAXEXP + dblprec + 1))
-	    return BOOL_F; /* exponent too large */
+/* 	if (expon > MAXEXP) */
+/* 	  if (1==expsgn || expon > (MAXEXP + dblprec + 1)) */
+/* 	    return BOOL_F; /\* exponent too large *\/ */
 	break;
       default:
 	goto out4;
@@ -786,8 +792,8 @@ SCM string2number(str, radix)
      SCM str, radix;
 {
   if UNBNDP(radix) radix=MAKINUM(10L);
-  else ASSERT(INUMP(radix), radix, ARG2, s_str2number);
-  ASSERT(NIMP(str) && STRINGP(str), str, ARG1, s_str2number);
+  else ASRTER(INUMP(radix), radix, ARG2, s_str2number);
+  ASRTER(NIMP(str) && STRINGP(str), str, ARG1, s_str2number);
   return istring2number(CHARS(str), LENGTH(str), INUM(radix));
 }
 /*** END strs->nums ***/
@@ -840,9 +846,7 @@ SCM eqv(x, y)
     if BIGP(x) return (0==bigcomp(x, y)) ? BOOL_T : BOOL_F;
 # endif
 # ifdef FLOATS
-    if (REALPART(x) != REALPART(y)) return BOOL_F;
-    if (CPLXP(x) && (IMAG(x) != IMAG(y))) return BOOL_F;
-    return BOOL_T;
+    return floequal(x, y);
 # endif
   }
   return BOOL_F;
@@ -882,10 +886,10 @@ SCM list_tail(lst, k)
      SCM lst, k;
 {
   register long i;
-  ASSERT(INUMP(k), k, ARG2, s_list_tail);
+  ASRTER(INUMP(k), k, ARG2, s_list_tail);
   i = INUM(k);
   while (i-- > 0) {
-    ASSERT(NIMP(lst) && CONSP(lst), lst, ARG1, s_list_tail);
+    ASRTER(NIMP(lst) && CONSP(lst), lst, ARG1, s_list_tail);
     lst = CDR(lst);
   }
   return lst;
@@ -897,7 +901,7 @@ SCM string2list(str)
   long i;
   SCM res = EOL;
   unsigned char *src;
-  ASSERT(NIMP(str) && STRINGP(str), str, ARG1, s_str2list);
+  ASRTER(NIMP(str) && STRINGP(str), str, ARG1, s_str2list);
   src = UCHARS(str);
   for(i = LENGTH(str)-1;i >= 0;i--) res = cons((SCM)MAKICHR(src[i]), res);
   return res;
@@ -905,7 +909,7 @@ SCM string2list(str)
 SCM string_copy(str)
      SCM str;
 {
-  ASSERT(NIMP(str) && STRINGP(str), str, ARG1, s_st_copy);
+  ASRTER(NIMP(str) && STRINGP(str), str, ARG1, s_st_copy);
   return makfromstr(CHARS(str), (sizet)LENGTH(str));
 }
 SCM string_fill(str, chr)
@@ -913,8 +917,8 @@ SCM string_fill(str, chr)
 {
   register char *dst, c;
   register long k;
-  ASSERT(NIMP(str) && STRINGP(str), str, ARG1, s_st_fill);
-  ASSERT(ICHRP(chr), chr, ARG2, s_st_fill);
+  ASRTER(NIMP(str) && STRINGP(str), str, ARG1, s_st_fill);
+  ASRTER(ICHRP(chr), chr, ARG2, s_st_fill);
   c = ICHR(chr);
   dst = CHARS(str);
   for(k = LENGTH(str)-1;k >= 0;k--) dst[k] = c;
@@ -926,7 +930,7 @@ SCM vector2list(v)
   SCM res = EOL;
   long i;
   SCM *data;
-  ASSERT(NIMP(v) && VECTORP(v), v, ARG1, s_vect2list);
+  ASRTER(NIMP(v) && VECTORP(v), v, ARG1, s_vect2list);
   data = VELTS(v);
   for(i = LENGTH(v)-1;i >= 0;i--) res = cons(data[i], res);
   return res;
@@ -936,7 +940,7 @@ SCM vector_fill(v, fill)
 {
   register long i;
   register SCM *data;
-  ASSERT(NIMP(v) && VECTORP(v), v, ARG1, s_ve_fill);
+  ASRTER(NIMP(v) && VECTORP(v), v, ARG1, s_ve_fill);
   data = VELTS(v);
   for(i = LENGTH(v)-1;i >= 0;i--) data[i] = fill;
   return UNSPECIFIED;
@@ -958,12 +962,14 @@ SCM bigequal(x, y)
 }
 #endif
 #ifdef FLOATS
+# define REALLY_UNEQUAL(x,y) ((x) != (y) && !((x)!=(x) && (y)!=(y)))
 SCM floequal(x, y)
      SCM x, y;
 {
-  if (REALPART(x) != REALPART(y)) return BOOL_F;
-  if (!(CPLXP(x) && (IMAG(x) != IMAG(y)))) return BOOL_T;
-  return BOOL_F;
+  if (REALLY_UNEQUAL(REALPART(x), REALPART(y))) return BOOL_F;
+  if (CPLXP(x))
+    return (CPLXP(y) && !REALLY_UNEQUAL(IMAG(x), IMAG(y))) ? BOOL_T : BOOL_F;
+  return CPLXP(y) ? BOOL_F : BOOL_T;
 }
 #endif
 SCM equal(x, y)
@@ -1030,7 +1036,7 @@ int scm_bigdblcomp(b, d)
   blen = INUM(scm_intlength(b));
   if (blen > dlen) return dneg ? 1 : -1;
   if (blen < dlen) return dneg ? -1 : 1;
-  if ((blen <= DBL_MANT_DIG) || (blen - scm_twos_power(b)) <= DBL_MANT_DIG) {
+  if ((blen <= dbl_mant_dig) || (blen - scm_twos_power(b)) <= dbl_mant_dig) {
     double bd = big2dbl(b);
     if (bd > d) return -1;
     if (bd < d) return 1;
@@ -1075,6 +1081,7 @@ SCM inexactp(x)
 #endif
   return BOOL_F;
 }
+
 SCM eqp(x, y)
      SCM x, y;
 {
@@ -1097,7 +1104,7 @@ SCM eqp(x, y)
     }
     ASRTGO(INEXP(x), badx);
 # else
-    ASSERT(NIMP(x) && INEXP(x), x, ARG1, s_eqp);
+    ASRTER(NIMP(x) && INEXP(x), x, ARG1, s_eqp);
 # endif
     if INUMP(y) {t = x; x = y; y = t; goto realint;}
 # ifdef BIGDIG
@@ -1107,10 +1114,8 @@ SCM eqp(x, y)
 # else
     ASRTGO(NIMP(y) && INEXP(y), bady);
 # endif
-    if (REALPART(x) != REALPART(y)) return BOOL_F;
-    if CPLXP(x)
-      return (CPLXP(y) && (IMAG(x)==IMAG(y))) ? BOOL_T : BOOL_F;
-    return CPLXP(y) ? BOOL_F : BOOL_T;
+    if (x==y) return BOOL_T;
+    return floequal(x, y);
   }
   if NINUMP(y) {
 # ifdef BIGDIG
@@ -1132,7 +1137,7 @@ SCM eqp(x, y)
 #else
 # ifdef BIGDIG
   if NINUMP(x) {
-    ASSERT(NIMP(x) && BIGP(x), x, ARG1, s_eqp);
+    ASRTER(NIMP(x) && BIGP(x), x, ARG1, s_eqp);
     if INUMP(y) return BOOL_F;
     ASRTGO(NIMP(y) && BIGP(y), bady);
     return (0==bigcomp(x, y)) ? BOOL_T : BOOL_F;
@@ -1145,8 +1150,8 @@ SCM eqp(x, y)
     return BOOL_F;
   }
 # else
-  ASSERT(INUMP(x), x, ARG1, s_eqp);
-  ASSERT(INUMP(y), y, ARG2, s_eqp);
+  ASRTER(INUMP(x), x, ARG1, s_eqp);
+  ASRTER(INUMP(y), y, ARG2, s_eqp);
 # endif
 #endif
   return ((long)x==(long)y) ? BOOL_T : BOOL_F;
@@ -1170,7 +1175,7 @@ SCM lessp(x, y)
     }
     ASRTGO(REALP(x), badx);
 # else
-    ASSERT(NIMP(x) && REALP(x), x, ARG1, s_lessp);
+    ASRTER(NIMP(x) && REALP(x), x, ARG1, s_lessp);
 # endif
     if INUMP(y) return (REALPART(x) < ((double)INUM(y))) ? BOOL_T : BOOL_F;
 # ifdef BIGDIG
@@ -1201,7 +1206,7 @@ SCM lessp(x, y)
 #else
 # ifdef BIGDIG
   if NINUMP(x) {
-    ASSERT(NIMP(x) && BIGP(x), x, ARG1, s_lessp);
+    ASRTER(NIMP(x) && BIGP(x), x, ARG1, s_lessp);
     if INUMP(y) return BIGSIGN(x) ? BOOL_T : BOOL_F;
     ASRTGO(NIMP(y) && BIGP(y), bady);
     return (1==bigcomp(x, y)) ? BOOL_T : BOOL_F;
@@ -1214,8 +1219,8 @@ SCM lessp(x, y)
     return BIGSIGN(y) ? BOOL_F : BOOL_T;
   }
 # else
-  ASSERT(INUMP(x), x, ARG1, s_lessp);
-  ASSERT(INUMP(y), y, ARG2, s_lessp);
+  ASRTER(INUMP(x), x, ARG1, s_lessp);
+  ASRTER(INUMP(y), y, ARG2, s_lessp);
 # endif
 #endif
   return ((long)x < (long)y) ? BOOL_T : BOOL_F;
@@ -1248,18 +1253,18 @@ SCM zerop(z)
       badz: wta(z, (char *)ARG1, s_zerop);
 #  endif
 # else
-    ASSERT(NIMP(z) && INEXP(z), z, ARG1, s_zerop);
+    ASRTER(NIMP(z) && INEXP(z), z, ARG1, s_zerop);
 # endif
     return (z==flo0) ? BOOL_T : BOOL_F;
   }
 #else
 # ifdef BIGDIG
   if NINUMP(z) {
-    ASSERT(NIMP(z) && BIGP(z), z, ARG1, s_zerop);
+    ASRTER(NIMP(z) && BIGP(z), z, ARG1, s_zerop);
     return BOOL_F;
   }
 # else
-  ASSERT(INUMP(z), z, ARG1, s_zerop);
+  ASRTER(INUMP(z), z, ARG1, s_zerop);
 # endif
 #endif
   return (z==INUM0) ? BOOL_T: BOOL_F;
@@ -1277,18 +1282,18 @@ SCM positivep(x)
       badx: wta(x, (char *)ARG1, s_positivep);
 #  endif
 # else
-    ASSERT(NIMP(x) && REALP(x), x, ARG1, s_positivep);
+    ASRTER(NIMP(x) && REALP(x), x, ARG1, s_positivep);
 # endif
     return (REALPART(x) > 0.0) ? BOOL_T : BOOL_F;
   }
 #else
 # ifdef BIGDIG
   if NINUMP(x) {
-    ASSERT(NIMP(x) && BIGP(x), x, ARG1, s_positivep);
+    ASRTER(NIMP(x) && BIGP(x), x, ARG1, s_positivep);
     return TYP16(x)==tc16_bigpos ? BOOL_T : BOOL_F;
   }
 # else
-  ASSERT(INUMP(x), x, ARG1, s_positivep);
+  ASRTER(INUMP(x), x, ARG1, s_positivep);
 # endif
 #endif
   return (x > INUM0) ? BOOL_T : BOOL_F;
@@ -1306,18 +1311,18 @@ SCM negativep(x)
       badx: wta(x, (char *)ARG1, s_negativep);
 #  endif
 # else
-    ASSERT(NIMP(x) && REALP(x), x, ARG1, s_negativep);
+    ASRTER(NIMP(x) && REALP(x), x, ARG1, s_negativep);
 # endif
     return (REALPART(x) < 0.0) ? BOOL_T : BOOL_F;
   }
 #else
 # ifdef BIGDIG
   if NINUMP(x) {
-    ASSERT(NIMP(x) && BIGP(x), x, ARG1, s_negativep);
+    ASRTER(NIMP(x) && BIGP(x), x, ARG1, s_negativep);
     return (TYP16(x)==tc16_bigneg) ? BOOL_T : BOOL_F;
   }
 # else
-  ASSERT(INUMP(x), x, ARG1, s_negativep);
+  ASRTER(INUMP(x), x, ARG1, s_negativep);
 # endif
 #endif
   return (x < INUM0) ? BOOL_T : BOOL_F;
@@ -1350,12 +1355,12 @@ SCM lmax(x, y)
     big_dbl:
       if (-1 != scm_bigdblcomp(x, REALPART(y))) return y;
       z = big2dbl(x);
-      ASSERT(0==scm_bigdblcomp(x, z), x, s_exactprob, s_max);
+      ASRTER(0==scm_bigdblcomp(x, z), x, s_exactprob, s_max);
       return makdbl(z, 0.0);
     }
     ASRTGO(REALP(x), badx);
 # else
-    ASSERT(NIMP(x) && REALP(x), x, ARG1, s_max);
+    ASRTER(NIMP(x) && REALP(x), x, ARG1, s_max);
 # endif
     if INUMP(y) return (REALPART(x) < (z = INUM(y))) ? makdbl(z, 0.0) : x;
 # ifdef BIGDIG
@@ -1388,7 +1393,7 @@ SCM lmax(x, y)
 #else
 # ifdef BIGDIG
   if NINUMP(x) {
-    ASSERT(NIMP(x) && BIGP(x), x, ARG1, s_max);
+    ASRTER(NIMP(x) && BIGP(x), x, ARG1, s_max);
     if INUMP(y) return BIGSIGN(x) ? y : x;
     ASRTGO(NIMP(y) && BIGP(y), bady);
     return (1==bigcomp(x, y)) ? y : x;
@@ -1401,8 +1406,8 @@ SCM lmax(x, y)
     return BIGSIGN(y) ? x : y;
   }
 # else
-  ASSERT(INUMP(x), x, ARG1, s_max);
-  ASSERT(INUMP(y), y, ARG2, s_max);
+  ASRTER(INUMP(x), x, ARG1, s_max);
+  ASRTER(INUMP(y), y, ARG2, s_max);
 # endif
 #endif
   return ((long)x < (long)y) ? y : x;
@@ -1434,12 +1439,12 @@ SCM lmin(x, y)
     big_dbl:
       if (1 != scm_bigdblcomp(x, REALPART(y))) return y;
       z = big2dbl(x);
-      ASSERT(0==scm_bigdblcomp(x, z), x, s_exactprob, s_min);
+      ASRTER(0==scm_bigdblcomp(x, z), x, s_exactprob, s_min);
       return makdbl(z, 0.0);
     }
     ASRTGO(REALP(x), badx);
 # else
-    ASSERT(NIMP(x) && REALP(x), x, ARG1, s_min);
+    ASRTER(NIMP(x) && REALP(x), x, ARG1, s_min);
 # endif
     if INUMP(y) return (REALPART(x) > (z = INUM(y))) ? makdbl(z, 0.0) : x;
 # ifdef BIGDIG
@@ -1472,7 +1477,7 @@ SCM lmin(x, y)
 #else
 # ifdef BIGDIG
   if NINUMP(x) {
-    ASSERT(NIMP(x) && BIGP(x), x, ARG1, s_min);
+    ASRTER(NIMP(x) && BIGP(x), x, ARG1, s_min);
     if INUMP(y) return BIGSIGN(x) ? x : y;
     ASRTGO(NIMP(y) && BIGP(y), bady);
     return (-1==bigcomp(x, y)) ? y : x;
@@ -1485,8 +1490,8 @@ SCM lmin(x, y)
     return BIGSIGN(y) ? y : x;
   }
 # else
-  ASSERT(INUMP(x), x, ARG1, s_min);
-  ASSERT(INUMP(y), y, ARG2, s_min);
+  ASRTER(INUMP(x), x, ARG1, s_min);
+  ASRTER(INUMP(y), y, ARG2, s_min);
 # endif
 #endif
   return ((long)x > (long)y) ? y : x;
@@ -1589,7 +1594,7 @@ SCM sum(x, y)
   }
 # else
   ASRTGO(INUMP(x), badx);
-  ASSERT(INUMP(y), y, ARG2, s_sum);
+  ASRTER(INUMP(y), y, ARG2, s_sum);
 # endif
 #endif
   x = INUM(x)+INUM(y);
@@ -1642,11 +1647,12 @@ SCM difference(x, y)
     ASRTGO(INEXP(x), badx);
     ASRTGO(NIMP(y) && INEXP(y), bady);
 # endif
-    if CPLXP(x)
+    if CPLXP(x) {
       if CPLXP(y)
 	return makdbl(REAL(x)-REAL(y), IMAG(x)-IMAG(y));
       else
 	return makdbl(REAL(x)-REALPART(y), IMAG(x));
+    }
     return makdbl(REALPART(x)-REALPART(y), CPLXP(y)?-IMAG(y):0.0);
   }
   if UNBNDP(y) {x = -INUM(x); goto checkx;}
@@ -1678,7 +1684,7 @@ SCM difference(x, y)
 #else
 # ifdef BIGDIG
   if NINUMP(x) {
-    ASSERT(NIMP(x) && BIGP(x), x, ARG1, s_difference);
+    ASRTER(NIMP(x) && BIGP(x), x, ARG1, s_difference);
     if UNBNDP(y) {
       x = copybig(x, !BIGSIGN(x));
       return NUMDIGS(x) * BITSPERDIG/CHAR_BIT <= sizeof(SCM) ?
@@ -1717,9 +1723,9 @@ SCM difference(x, y)
     }
   }
 # else
-  ASSERT(INUMP(x), x, ARG1, s_difference);
+  ASRTER(INUMP(x), x, ARG1, s_difference);
   if UNBNDP(y) {x = -INUM(x); goto checkx;}
-  ASSERT(INUMP(y), y, ARG2, s_difference);
+  ASRTER(INUMP(y), y, ARG2, s_difference);
 # endif
 #endif
   x = INUM(x)-INUM(y);
@@ -1779,12 +1785,13 @@ SCM product(x, y)
     bady: wta(y, (char *)ARG2, s_product);
 #  endif
 # endif
-    if CPLXP(x)
+    if CPLXP(x) {
       if CPLXP(y)
 	return makdbl(REAL(x)*REAL(y)-IMAG(x)*IMAG(y),
 		      REAL(x)*IMAG(y)+IMAG(x)*REAL(y));
       else
 	return makdbl(REAL(x)*REALPART(y), IMAG(x)*REALPART(y));
+    }
     return makdbl(REALPART(x)*REALPART(y),
 		  CPLXP(y)?REALPART(x)*IMAG(y):0.0);
   }
@@ -1842,7 +1849,7 @@ SCM product(x, y)
   }
 # else
   ASRTGO(INUMP(x), badx);
-  ASSERT(INUMP(y), y, ARG2, s_product);
+  ASRTER(INUMP(y), y, ARG2, s_product);
 # endif
 #endif
   {
@@ -1902,7 +1909,7 @@ SCM divide(x, y)
       SCM z;
       if INUMP(y) {
         z = INUM(y);
-        ASSERT(z, y, OVFLOW, s_divide);
+        ASRTER(z, y, OVFLOW, s_divide);
 	if (1==z) return x;
         if (z < 0) z = -z;
         if (z < BIGRAD) {
@@ -1978,7 +1985,7 @@ SCM divide(x, y)
 # ifdef BIGDIG
   if NINUMP(x) {
     SCM z;
-    ASSERT(NIMP(x) && BIGP(x), x, ARG1, s_divide);
+    ASRTER(NIMP(x) && BIGP(x), x, ARG1, s_divide);
     if UNBNDP(y) goto ov;
     if INUMP(y) {
       z = INUM(y);
@@ -2020,12 +2027,12 @@ SCM divide(x, y)
     goto ov;
   }
 # else
-  ASSERT(INUMP(x), x, ARG1, s_divide);
+  ASRTER(INUMP(x), x, ARG1, s_divide);
   if UNBNDP(y) {
     if ((MAKINUM(1L)==x) || (MAKINUM(-1L)==x)) return x;
     goto ov;
   }
-  ASSERT(INUMP(y), y, ARG2, s_divide);
+  ASRTER(INUMP(y), y, ARG2, s_divide);
 # endif
 #endif
   {
@@ -2056,7 +2063,7 @@ SCM scm_intexpt(z1, z2)
   if (INUM0==z1 || acc==z1) return z1;
   else if (MAKINUM(-1L)==z1) return BOOL_F==evenp(z2)?z1:acc;
 #endif
-  ASSERT(INUMP(z2), z2, ARG2, s_intexpt);
+  ASRTER(INUMP(z2), z2, ARG2, s_intexpt);
   z2 = INUM(z2);
   if (z2 < 0) {
     z2 = -z2;
@@ -2101,7 +2108,7 @@ SCM scm_intexpt(z1, z2)
 #endif
     goto ret;
   }
-  ASSERT(NIMP(z1), z1, ARG1, s_intexpt);
+  ASRTER(NIMP(z1), z1, ARG1, s_intexpt);
 #ifdef FLOATS
   if REALP(z1) {
     dz1 = REALPART(z1);
@@ -2183,7 +2190,7 @@ void two_doubles(z1, z2, sstring, xy)
 #  endif
       xy->x = REALPART(z1);}
 # else
-    {ASSERT(NIMP(z1) && REALP(z1), z1, ARG1, sstring);
+    {ASRTER(NIMP(z1) && REALP(z1), z1, ARG1, sstring);
      xy->x = REALPART(z1);}
 # endif
   }
@@ -2199,7 +2206,7 @@ void two_doubles(z1, z2, sstring, xy)
 #  endif
       xy->y = REALPART(z2);}
 # else
-    {ASSERT(NIMP(z2) && REALP(z2), z2, ARG2, sstring);
+    {ASRTER(NIMP(z2) && REALP(z2), z2, ARG2, sstring);
      xy->y = REALPART(z2);}
 # endif
   }
@@ -2246,7 +2253,7 @@ SCM real_part(z)
     badz: wta(z, (char *)ARG1, s_real_part);
 #  endif
 # else
-    ASSERT(NIMP(z) && INEXP(z), z, ARG1, s_real_part);
+    ASRTER(NIMP(z) && INEXP(z), z, ARG1, s_real_part);
 # endif
     if CPLXP(z) return makdbl(REAL(z), 0.0);
   }
@@ -2264,7 +2271,7 @@ SCM imag_part(z)
   badz: wta(z, (char *)ARG1, s_imag_part);
 #  endif
 # else
-  ASSERT(NIMP(z) && INEXP(z), z, ARG1, s_imag_part);
+  ASRTER(NIMP(z) && INEXP(z), z, ARG1, s_imag_part);
 # endif
   if CPLXP(z) return makdbl(IMAG(z), 0.0);
   return flo0;
@@ -2281,7 +2288,7 @@ SCM magnitude(z)
   badz: wta(z, (char *)ARG1, s_magnitude);
 #  endif
 # else
-  ASSERT(NIMP(z) && INEXP(z), z, ARG1, s_magnitude);
+  ASRTER(NIMP(z) && INEXP(z), z, ARG1, s_magnitude);
 # endif
   if CPLXP(z)
     {
@@ -2304,7 +2311,7 @@ SCM angle(z)
     badz: wta(z, (char *)ARG1, s_angle);}
 #  endif
 # else
-  ASSERT(NIMP(z) && INEXP(z), z, ARG1, s_angle);
+  ASRTER(NIMP(z) && INEXP(z), z, ARG1, s_angle);
 # endif
   if REALP(z) {x = REALPART(z); goto do_angle;}
   x = REAL(z); y = IMAG(z);
@@ -2336,7 +2343,7 @@ SCM in2ex(z)
     badz: wta(z, (char *)ARG1, s_in2ex);
 #  endif
 # else
-  ASSERT(NIMP(z) && REALP(z), z, ARG1, s_in2ex);
+  ASRTER(NIMP(z) && REALP(z), z, ARG1, s_in2ex);
 # endif
 # ifdef BIGDIG
   {
@@ -2349,7 +2356,7 @@ SCM in2ex(z)
       SCM ans = MAKINUM((long)u);
       if (INUM(ans)==(long)u) return ans;
     }
-    ASRTGO(!IS_INF(u), badz);	/* problem? */
+    ASRTGO(!(IS_INF(u) || (u)!=(u)), badz); /* problem? */
     return dbl2big(u);
   }
 # else
@@ -2361,7 +2368,7 @@ static char s_trunc[] = "truncate";
 SCM numident(x)
      SCM x;
 {
-  ASSERT(INUMP(x), x, ARG1, s_trunc);
+  ASRTER(INUMP(x), x, ARG1, s_trunc);
   return x;
 }
 #endif				/* FLOATS */
@@ -2385,7 +2392,7 @@ SCM dbl2big(d)
     u -= c;
     digits[i] = c;
   }
-  ASSERT(0==u, INUM0, OVFLOW, "dbl2big");
+  ASRTER(0==u, INUM0, OVFLOW, "dbl2big");
   return ans;
 }
 double big2dbl(b)
@@ -2480,7 +2487,7 @@ static char s_dfloat_parts[] = "double-float-parts";
 SCM scm_dfloat_parts(f)
      SCM f;
 {
-  int expt, ndig = DBL_MANT_DIG;
+  int expt, ndig = dbl_mant_dig;
   double mant = frexp(num2dbl(f, (char *)ARG1, s_dfloat_parts), &expt);
 #  ifdef DBL_MIN_EXP
   if (expt < DBL_MIN_EXP)
@@ -2496,8 +2503,8 @@ SCM scm_make_dfloat(mant, expt)
 {
   double dmant = num2dbl(mant, (char *)ARG1, s_make_dfloat);
   int e = INUM(expt);
-  ASSERT(INUMP(expt), expt, ARG2, s_make_dfloat);
-  ASSERT((dmant < 0 ? -dmant : dmant)<=max_dbl_int, mant,
+  ASRTER(INUMP(expt), expt, ARG2, s_make_dfloat);
+  ASRTER((dmant < 0 ? -dmant : dmant)<=max_dbl_int, mant,
 	 OUTOFRANGE, s_make_dfloat);
   return makdbl(ldexp(dmant, e), 0.0);
 }
@@ -2515,7 +2522,7 @@ SCM scm_next_dfloat(f1, f2)
     if (e < DBL_MIN_EXP)
       eps = ldexp(eps, DBL_MIN_EXP - e);
     else if (0.0==d)
-      eps = ldexp(1.0, DBL_MIN_EXP - DBL_MANT_DIG);
+      eps = ldexp(1.0, DBL_MIN_EXP - dbl_mant_dig);
 #  endif
     d = ldexp(d + eps, e);
   }
@@ -2524,7 +2531,7 @@ SCM scm_next_dfloat(f1, f2)
     if (e < DBL_MIN_EXP)
       eps = ldexp(eps, DBL_MIN_EXP - e);
     else if (0.0==d)
-      eps = ldexp(-1.0, DBL_MIN_EXP - DBL_MANT_DIG);
+      eps = ldexp(-1.0, DBL_MIN_EXP - dbl_mant_dig);
 #  endif
     if (0.5==d) eps *= 0.5;
     d = ldexp(d - eps, e);
@@ -2616,7 +2623,7 @@ SCM hash(obj, n)
      SCM obj;
      SCM n;
 {
-  ASSERT(INUMP(n) && 0 <= n, n, ARG2, s_hash);
+  ASRTER(INUMP(n) && 0 <= n, n, ARG2, s_hash);
   return MAKINUM(hasher(obj, INUM(n), 10));
 }
 
@@ -2624,7 +2631,7 @@ SCM hashv(obj, n)
      SCM obj;
      SCM n;
 {
-  ASSERT(INUMP(n) && 0 <= n, n, ARG2, s_hashv);
+  ASRTER(INUMP(n) && 0 <= n, n, ARG2, s_hashv);
   if ICHRP(obj) return MAKINUM((unsigned)(downcase[ICHR(obj)]) % INUM(n));
   if (NIMP(obj) && NUMP(obj)) return MAKINUM(hasher(obj, INUM(n), 10));
   else return MAKINUM(obj % INUM(n));
@@ -2634,7 +2641,7 @@ SCM hashq(obj, n)
      SCM obj;
      SCM n;
 {
-  ASSERT(INUMP(n) && 0 <= n, n, ARG2, s_hashq);
+  ASRTER(INUMP(n) && 0 <= n, n, ARG2, s_hashq);
   return MAKINUM((((unsigned) obj) >> 1) % INUM(n));
 }
 
@@ -2755,13 +2762,11 @@ static dblproc cxrs[] = {
 #endif
 
 #ifdef FLOATS
-/* # ifndef DBL_DIG -- also needed for ifndef DBL_MANT_DIG */
 static void add1(f, fsum)
      double f, *fsum;
 {
   *fsum = f + 1.0;
 }
-/* #endif */
 #endif
 
 void init_scl()
@@ -2803,7 +2808,7 @@ void init_scl()
 # ifdef DBL_MANT_DIG
   dbl_mant_dig = DBL_MANT_DIG;
 # else
-  if (!DBL_MANT_DIG) {		/* means we #defined it. */
+  {				/* means we #defined it. */
     double fsum = 0.0, eps = 1.0;
     int i = 0;
     while (fsum != 1.0) {
@@ -2816,7 +2821,7 @@ void init_scl()
 # endif /* DBL_MANT_DIG */
   max_dbl_int = pow(2.0, dbl_mant_dig - 1.0);
   max_dbl_int = max_dbl_int + (max_dbl_int - 1.0);
-  dbl_eps = ldexp(1.0, -dbl_mant_dig);
-  sysintern("double-float-mantissa-length", MAKINUM(DBL_MANT_DIG));
+  dbl_eps = ldexp(1.0, - dbl_mant_dig);
+  sysintern("double-float-mantissa-length", MAKINUM(dbl_mant_dig));
 #endif
 }