Import Upstream version 5e2upstream/5e2

1 files changed, 71 insertions, 94 deletions

diff --git a/subr.c b/subr.c
index 6c6bde9..06829b7 100644
--- a/subr.c
+++ b/subr.c
@@ -60,7 +60,7 @@ static char	s_symbol2string[] = "symbol->string",
 extern char s_inexactp[];
 #define s_exactp (s_inexactp+2)
 static char	s_oddp[] = "odd?", s_evenp[] = "even?";
-static char	s_abs[] = "abs", s_quotient[] = "quotient",
+static char	s_quotient[] = "quotient",
 	s_remainder[] = "remainder", s_modulo[] = "modulo";
 static char	s_gcd[] = "gcd";
 
@@ -108,7 +108,7 @@ SCM eq(x, y)
 SCM consp(x)
      SCM x;
 {
-	if IMP(x) return BOOL_F;
+	if (IMP(x)) return BOOL_F;
 	return CONSP(x) ? BOOL_T : BOOL_F;
 }
 SCM setcar(pair, value)
@@ -136,12 +136,12 @@ long ilength(sx)
 	register long i = 0;
 	register SCM x = sx;
 	do {
-		if IMP(x) return NULLP(x) ? i : -1;
-		if NCONSP(x) return -2;
+		if (IMP(x)) return NULLP(x) ? i : -1;
+		if (NCONSP(x)) return -2;
 		x = CDR(x);
 		i++;
-		if IMP(x) return NULLP(x) ? i : -1;
-		if NCONSP(x) return -2;
+		if (IMP(x)) return NULLP(x) ? i : -1;
+		if (NCONSP(x)) return -2;
 		x = CDR(x);
 		i++;
 		sx = CDR(sx);
@@ -172,7 +172,7 @@ SCM append(args)
 {
 	SCM res = EOL;
 	SCM *lloc = &res, arg;
-	if IMP(args) {
+	if (IMP(args)) {
 		ASRTER(NULLP(args), args, ARGn, s_append);
 		return res;
 		}
@@ -180,7 +180,7 @@ SCM append(args)
 	while (1) {
 		arg = CAR(args);
 		args = CDR(args);
-		if IMP(args) {
+		if (IMP(args)) {
 			*lloc = arg;
 			ASRTER(NULLP(args), args, ARGn, s_append);
 			return res;
@@ -236,7 +236,7 @@ SCM member(x, lst)
 {
 	for(;NIMP(lst);lst = CDR(lst)) {
 		ASRTER(CONSP(lst), lst, ARG2, s_member);
-		if NFALSEP(equal(CAR(lst), x)) return lst;
+		if (NFALSEP(equal(CAR(lst), x))) return lst;
 	}
 	ASRTER(NULLP(lst), lst, ARG2, s_member);
 	return BOOL_F;
@@ -262,7 +262,7 @@ SCM assoc(x, alist)
 		ASRTER(CONSP(alist), alist, ARG2, s_assoc);
 		tmp = CAR(alist);
 		ASRTER(NIMP(tmp) && CONSP(tmp), alist, ARG2, s_assoc);
-		if NFALSEP(equal(CAR(tmp), x)) return tmp;
+		if (NFALSEP(equal(CAR(tmp), x))) return tmp;
 	}
 	ASRTER(NULLP(alist), alist, ARG2, s_assoc);
 	return BOOL_F;
@@ -278,7 +278,7 @@ SCM promisep(x)
 SCM symbolp(x)
      SCM x;
 {
-	if IMP(x) return BOOL_F;
+	if (IMP(x)) return BOOL_F;
 	return SYMBOLP(x) ? BOOL_T : BOOL_F;
 }
 SCM symbol2string(s)
@@ -298,7 +298,7 @@ SCM string2symbol(s)
 SCM exactp(x)
      SCM x;
 {
-	if INUMP(x) return BOOL_T;
+	if (INUMP(x)) return BOOL_T;
 #ifdef BIGDIG
 	if (NIMP(x) && BIGP(x)) return BOOL_T;
 #endif
@@ -308,7 +308,7 @@ SCM oddp(n)
      SCM n;
 {
 #ifdef BIGDIG
-	if NINUMP(n) {
+	if (NINUMP(n)) {
 	  ASRTER(NIMP(n) && BIGP(n), n, ARG1, s_oddp);
 	  return (1 & BDIGITS(n)[0]) ? BOOL_T : BOOL_F;
 	}
@@ -321,7 +321,7 @@ SCM evenp(n)
      SCM n;
 {
 #ifdef BIGDIG
-	if NINUMP(n) {
+	if (NINUMP(n)) {
 	  ASRTER(NIMP(n) && BIGP(n), n, ARG1, s_evenp);
 	  return (1 & BDIGITS(n)[0]) ? BOOL_F : BOOL_T;
 	}
@@ -330,37 +330,15 @@ SCM evenp(n)
 #endif
 	return (4 & (int)n) ? BOOL_F : BOOL_T;
 }
-SCM absval(x)
-     SCM x;
-{
-#ifdef BIGDIG
-  if NINUMP(x) {
-    ASRTER(NIMP(x) && BIGP(x), x, ARG1, s_abs);
-    if (TYP16(x)==tc16_bigpos) return x;
-    return copybig(x, 0);
-  }
-#else
-  ASRTER(INUMP(x), x, ARG1, s_abs);
-#endif
-  if (INUM(x) >= 0) return x;
-  x = -INUM(x);
-  if (!POSFIXABLE(x))
-#ifdef BIGDIG
-    return long2big(x);
-#else
-    wta(MAKINUM(-x), (char *)OVFLOW, s_abs);
-#endif
-  return MAKINUM(x);
-}
 SCM lquotient(x, y)
      SCM x, y;
 {
   register long z;
 #ifdef BIGDIG
-  if NINUMP(x) {
+  if (NINUMP(x)) {
     long w;
     ASRTER(NIMP(x) && BIGP(x), x, ARG1, s_quotient);
-    if NINUMP(y) {
+    if (NINUMP(y)) {
       ASRTGO(NIMP(y) && BIGP(y), bady);
       return divbigbig(BDIGITS(x), NUMDIGS(x), BDIGITS(y), NUMDIGS(y),
 		       BIGSIGN(x) ^ BIGSIGN(y), 2);
@@ -386,7 +364,7 @@ SCM lquotient(x, y)
     }
 # endif
   }
-  if NINUMP(y) {
+  if (NINUMP(y)) {
 # ifndef RECKLESS
     if (!(NIMP(y) && BIGP(y)))
     bady: wta(y, (char *)ARG2, s_quotient);
@@ -427,9 +405,9 @@ SCM lremainder(x, y)
 {
   register long z;
 #ifdef BIGDIG
-  if NINUMP(x) {
+  if (NINUMP(x)) {
     ASRTER(NIMP(x) && BIGP(x), x, ARG1, s_remainder);
-    if NINUMP(y) {
+    if (NINUMP(y)) {
       ASRTGO(NIMP(y) && BIGP(y), bady);
       return divbigbig(BDIGITS(x), NUMDIGS(x), BDIGITS(y), NUMDIGS(y),
 		       BIGSIGN(x), 0);
@@ -437,7 +415,7 @@ SCM lremainder(x, y)
     if (!(z = INUM(y))) goto ov;
     return divbigint(x, z, BIGSIGN(x), 0);
   }
-  if NINUMP(y) {
+  if (NINUMP(y)) {
 # ifndef RECKLESS
     if (!(NIMP(y) && BIGP(y)))
     bady: wta(y, (char *)ARG2, s_remainder);
@@ -468,9 +446,9 @@ SCM modulo(x, y)
 {
   register long yy, z;
 #ifdef BIGDIG
-  if NINUMP(x) {
+  if (NINUMP(x)) {
     ASRTER(NIMP(x) && BIGP(x), x, ARG1, s_modulo);
-    if NINUMP(y) {
+    if (NINUMP(y)) {
       ASRTGO(NIMP(y) && BIGP(y), bady);
       return divbigbig(BDIGITS(x), NUMDIGS(x), BDIGITS(y), NUMDIGS(y),
 		       BIGSIGN(y), (BIGSIGN(x) ^ BIGSIGN(y)) ? 1 : 0);
@@ -478,7 +456,7 @@ SCM modulo(x, y)
     if (!(z = INUM(y))) goto ov;
     return divbigint(x, z, z < 0, (BIGSIGN(x) ? (z > 0) : (z < 0)) ? 1 : 0);
   }
-  if NINUMP(y) {
+  if (NINUMP(y)) {
 # ifndef RECKLESS
     if (!(NIMP(y) && BIGP(y)))
     bady: wta(y, (char *)ARG2, s_modulo);
@@ -505,16 +483,16 @@ SCM lgcd(x, y)
 {
   register long u, v, k, t;
  tailrec:
-  if UNBNDP(y) return UNBNDP(x) ? INUM0 : x;
+  if (UNBNDP(y)) return UNBNDP(x) ? INUM0 : x;
 #ifdef BIGDIG
-  if NINUMP(x) {
+  if (NINUMP(x)) {
     big_gcd:
     ASRTER(NIMP(x) && BIGP(x), x, ARG1, s_gcd);
-    if BIGSIGN(x) x = copybig(x, 0);
+    if (BIGSIGN(x)) x = copybig(x, 0);
   newy:
-    if NINUMP(y) {
+    if (NINUMP(y)) {
       ASRTER(NIMP(y) && BIGP(y), y, ARG2, s_gcd);
-      if BIGSIGN(y) y = copybig(y, 0);
+      if (BIGSIGN(y)) y = copybig(y, 0);
       switch (bigcomp(x, y)) {
       case -1:
       swaprec: t = lremainder(x, y); x = y; y = t; goto tailrec;
@@ -525,7 +503,7 @@ SCM lgcd(x, y)
     }
     if (INUM0==y) return x; goto swaprec;
   }
-  if NINUMP(y) { t=x; x=y; y=t; goto big_gcd;}
+  if (NINUMP(y)) { t=x; x=y; y=t; goto big_gcd;}
 #else
   ASRTER(INUMP(x), x, ARG1, s_gcd);
   ASRTER(INUMP(y), y, ARG2, s_gcd);
@@ -562,13 +540,13 @@ SCM llcm(n1, n2)
      SCM n1, n2;
 {
   SCM d;
-  if UNBNDP(n2) {
+  if (UNBNDP(n2)) {
     n2 = MAKINUM(1L);
-    if UNBNDP(n1) return n2;
+    if (UNBNDP(n1)) return n2;
   }
   d = lgcd(n1, n2);
   if (INUM0==d) return d;
-  return absval(product(n1, lquotient(n2, d)));
+  return scm_iabs(product(n1, lquotient(n2, d)));
 }
 
 /* Emulating 2's complement bignums with sign magnitude arithmetic:
@@ -624,7 +602,7 @@ SCM scm_copy_big_dec(b, sign)
   sizet i = 0;
   SCM ans = mkbig(nx, sign);
   BIGDIG *src = BDIGITS(b), *dst = BDIGITS(ans);
-  if BIGSIGN(b) do {
+  if (BIGSIGN(b)) do {
     num += src[i];
     if (num < 0) {dst[i] = num + BIGRAD; num = -1;}
     else {dst[i] = BIGLO(num); num = 0;}
@@ -784,7 +762,7 @@ SCM scm_big_test(x, nx, xsgn, bigy)
 	num = 0;
       }
     } while (++i < nx);
-  else if BIGSIGN(bigy)
+  else if (BIGSIGN(bigy))
     do {
       num += y[i];
       if (num < 0) {
@@ -814,7 +792,7 @@ static SCM scm_copy_big_2scomp(x, blen, sign)
   BIGDIG *rds;
   long num = 0;
   sizet i;
-  if INUMP(x) {
+  if (INUMP(x)) {
     long lx = INUM(x);
     if (nres < (LONG_BIT + BITSPERDIG - 1)/BITSPERDIG)
       nres = (LONG_BIT + BITSPERDIG - 1)/BITSPERDIG;
@@ -849,7 +827,7 @@ static SCM scm_copy_big_2scomp(x, blen, sign)
       nres = nx;
     res = mkbig(nres, sign);
     rds = BDIGITS(res);
-    if BIGSIGN(x) {
+    if (BIGSIGN(x)) {
       for (i = 0; i < nx; i++) {
 	num -= xds[i];
 	if (num < 0) {
@@ -901,7 +879,7 @@ SCM scm_big_ash(x, cnt)
   unsigned long d;
   int sign, ishf;
   long i, fshf, blen, n;
-  if INUMP(x) {
+  if (INUMP(x)) {
     blen = LONG_BIT;
     sign = INUM(x) < 0 ? 0x0100 : 0;
   }
@@ -962,8 +940,8 @@ static char s_logand[] = "logand", s_lognot[] = "lognot",
 SCM scm_logior(x, y)
      SCM x, y;
 {
-  if UNBNDP(y) {
-    if UNBNDP(x) return INUM0;
+  if (UNBNDP(y)) {
+    if (UNBNDP(x)) return INUM0;
 #ifndef RECKLESS
     if (!(NUMBERP(x)))
     badx: wta(x, (char *)ARG1, s_logior);
@@ -971,17 +949,17 @@ SCM scm_logior(x, y)
     return x;
   }
 #ifdef BIGDIG
-  if NINUMP(x) {
+  if (NINUMP(x)) {
     SCM t;
     ASRTGO(NIMP(x) && BIGP(x), badx);
-    if INUMP(y) {t = x; x = y; y = t; goto intbig;}
+    if (INUMP(y)) {t = x; x = y; y = t; goto intbig;}
     ASRTGO(NIMP(y) && BIGP(y), bady);
     if (NUMDIGS(x) > NUMDIGS(y)) {t = x; x = y; y = t;}
     if ((!BIGSIGN(x)) && !BIGSIGN(y))
       return scm_big_ior(BDIGITS(x), NUMDIGS(x), BIGSIGN(x), y);
     return scm_big_and(BDIGITS(x), NUMDIGS(x), BIGSIGN(x), y, 0x0100);
   }
-  if NINUMP(y) {
+  if (NINUMP(y)) {
 # ifndef RECKLESS
     if (!(NIMP(y) && BIGP(y)))
     bady: wta(y, (char *)ARG2, s_logior);
@@ -1011,8 +989,8 @@ SCM scm_logior(x, y)
 SCM scm_logand(x, y)
      SCM x, y;
 {
-  if UNBNDP(y) {
-    if UNBNDP(x) return MAKINUM(-1);
+  if (UNBNDP(y)) {
+    if (UNBNDP(x)) return MAKINUM(-1);
 #ifndef RECKLESS
     if (!(NUMBERP(x)))
     badx: wta(x, (char *)ARG1, s_logand);
@@ -1020,17 +998,17 @@ SCM scm_logand(x, y)
     return x;
   }
 #ifdef BIGDIG
-  if NINUMP(x) {
+  if (NINUMP(x)) {
     SCM t;
     ASRTGO(NIMP(x) && BIGP(x), badx);
-    if INUMP(y) {t = x; x = y; y = t; goto intbig;}
+    if (INUMP(y)) {t = x; x = y; y = t; goto intbig;}
     ASRTGO(NIMP(y) && BIGP(y), bady);
     if (NUMDIGS(x) > NUMDIGS(y)) {t = x; x = y; y = t;}
     if ((BIGSIGN(x)) && BIGSIGN(y))
       return scm_big_ior(BDIGITS(x), NUMDIGS(x), 0x0100, y);
     return scm_big_and(BDIGITS(x), NUMDIGS(x), BIGSIGN(x), y, 0);
   }
-  if NINUMP(y) {
+  if (NINUMP(y)) {
 # ifndef RECKLESS
     if (!(NIMP(y) && BIGP(y)))
     bady: wta(y, (char *)ARG2, s_logand);
@@ -1060,8 +1038,8 @@ SCM scm_logand(x, y)
 SCM scm_logxor(x, y)
      SCM x, y;
 {
-  if UNBNDP(y) {
-    if UNBNDP(x) return INUM0;
+  if (UNBNDP(y)) {
+    if (UNBNDP(x)) return INUM0;
 #ifndef RECKLESS
     if (!(NUMBERP(x)))
     badx: wta(x, (char *)ARG1, s_logxor);
@@ -1069,15 +1047,15 @@ SCM scm_logxor(x, y)
     return x;
   }
 #ifdef BIGDIG
-  if NINUMP(x) {
+  if (NINUMP(x)) {
     SCM t;
     ASRTGO(NIMP(x) && BIGP(x), badx);
-    if INUMP(y) {t = x; x = y; y = t; goto intbig;}
+    if (INUMP(y)) {t = x; x = y; y = t; goto intbig;}
     ASRTGO(NIMP(y) && BIGP(y), bady);
     if (NUMDIGS(x) > NUMDIGS(y)) {t = x; x = y; y = t;}
     return scm_big_xor(BDIGITS(x), NUMDIGS(x), BIGSIGN(x), y);
   }
-  if NINUMP(y) {
+  if (NINUMP(y)) {
 # ifndef RECKLESS
     if (!(NIMP(y) && BIGP(y)))
     bady: wta(y, (char *)ARG2, s_logxor);
@@ -1107,15 +1085,15 @@ SCM scm_logtest(x, y)
     badx: wta(x, (char *)ARG1, s_logtest);
 #endif
 #ifdef BIGDIG
-  if NINUMP(x) {
+  if (NINUMP(x)) {
     SCM t;
     ASRTGO(NIMP(x) && BIGP(x), badx);
-    if INUMP(y) {t = x; x = y; y = t; goto intbig;}
+    if (INUMP(y)) {t = x; x = y; y = t; goto intbig;}
     ASRTGO(NIMP(y) && BIGP(y), bady);
     if (NUMDIGS(x) > NUMDIGS(y)) {t = x; x = y; y = t;}
     return scm_big_test(BDIGITS(x), NUMDIGS(x), BIGSIGN(x), y);
   }
-  if NINUMP(y) {
+  if (NINUMP(y)) {
 # ifndef RECKLESS
     if (!(NIMP(y) && BIGP(y)))
     bady: wta(y, (char *)ARG2, s_logtest);
@@ -1142,10 +1120,10 @@ SCM scm_logbitp(index, j1)
 {
   ASRTER(INUMP(index) && INUM(index) >= 0, index, ARG1, s_logbitp);
 #ifdef BIGDIG
-  if NINUMP(j1) {
+  if (NINUMP(j1)) {
     ASRTER(NIMP(j1) && BIGP(j1), j1, ARG2, s_logbitp);
     if (NUMDIGS(j1) * BITSPERDIG < INUM(index)) return BOOL_F;
-    else if BIGSIGN(j1) {
+    else if (BIGSIGN(j1)) {
       long num = -1;
       sizet i = 0;
       BIGDIG *x = BDIGITS(j1);
@@ -1200,7 +1178,7 @@ SCM scm_copybit(index, j1, bit)
   ASRTER(INUMP(j1), j1, ARG2, s_copybit);
   ASRTER(INUM(index) < LONG_BIT - 3, index, OUTOFRANGE, s_copybit);
 #endif
-  if NFALSEP(bit)
+  if (NFALSEP(bit))
     return MAKINUM(INUM(j1) | (1L << INUM(index)));
   else
     return MAKINUM(INUM(j1) & (~(1L << INUM(index))));
@@ -1340,10 +1318,10 @@ SCM scm_logcount(n)
   register unsigned long c = 0;
   register long nn;
 #ifdef BIGDIG
-  if NINUMP(n) {
+  if (NINUMP(n)) {
     sizet i; BIGDIG *ds, d;
     ASRTER(NIMP(n) && BIGP(n), n, ARG1, s_logcount);
-    if BIGSIGN(n) return scm_logcount(difference(MAKINUM(-1L), n));
+    if (BIGSIGN(n)) return scm_logcount(difference(MAKINUM(-1L), n));
     ds = BDIGITS(n);
     for(i = NUMDIGS(n); i--; )
       for(d = ds[i]; d; d >>= 4) c += logtab[15 & d];
@@ -1365,10 +1343,10 @@ SCM scm_intlength(n)
   register long nn;
   unsigned int l = 4;
 #ifdef BIGDIG
-  if NINUMP(n) {
+  if (NINUMP(n)) {
     BIGDIG *ds, d;
     ASRTER(NIMP(n) && BIGP(n), n, ARG1, s_intlength);
-    if BIGSIGN(n) return scm_intlength(difference(MAKINUM(-1L), n));
+    if (BIGSIGN(n)) return scm_intlength(difference(MAKINUM(-1L), n));
     ds = BDIGITS(n);
     d = ds[c = NUMDIGS(n)-1];
     for(c *= BITSPERDIG; d; d >>= 4) {c += 4; l = ilentab[15 & d];}
@@ -1510,7 +1488,7 @@ SCM char_downcase(chr)
 SCM stringp(x)
      SCM x;
 {
-	if IMP(x) return BOOL_F;
+	if (IMP(x)) return BOOL_F;
 	return STRINGP(x) ? BOOL_T : BOOL_F;
 }
 SCM string(chrs)
@@ -1579,7 +1557,7 @@ SCM st_equal(s1, s2)
 	if (LENGTH(s1) != i) return BOOL_F;
 	c1 = UCHARS(s1);
 	c2 = UCHARS(s2);
-	while(0 != i--) if(*c1++ != *c2++) return BOOL_F;
+	while(0 != i--) if (*c1++ != *c2++) return BOOL_F;
 	return BOOL_T;
 }
 SCM stci_equal(s1, s2)
@@ -1593,7 +1571,7 @@ SCM stci_equal(s1, s2)
 	if (LENGTH(s1) != i) return BOOL_F;
 	c1 = UCHARS(s1);
 	c2 = UCHARS(s2);
-	while(0 != i--) if(upcase[*c1++] != upcase[*c2++]) return BOOL_F;
+	while(0 != i--) if (upcase[*c1++] != upcase[*c2++]) return BOOL_F;
 	return BOOL_T;
 }
 SCM st_lessp(s1, s2)
@@ -1706,7 +1684,7 @@ SCM st_append(args)
 SCM vectorp(x)
      SCM x;
 {
-	if IMP(x) return BOOL_F;
+	if (IMP(x)) return BOOL_F;
 	return VECTORP(x) ? BOOL_T : BOOL_F;
 }
 SCM vector_length(v)
@@ -1756,7 +1734,7 @@ SCM make_vector(k, fill)
 #else
   ASRTER(INUMP(k) && (!(~LENGTH_MAX & INUM(k))), k, ARG1, s_make_vector);
 #endif
-  if UNBNDP(fill) fill = UNSPECIFIED;
+  if (UNBNDP(fill)) fill = UNSPECIFIED;
   i = INUM(k);
   DEFER_INTS;
   v = must_malloc_cell(i ? i*sizeof(SCM) : 1L,
@@ -1789,9 +1767,9 @@ SCM big2inum(b, l)
   BIGDIG *tmp = BDIGITS(b);
   while (l--) num = BIGUP(num) + tmp[l];
   if (TYP16(b)==tc16_bigpos) {
-    if POSFIXABLE(num) return MAKINUM(num);
+    if (POSFIXABLE(num)) return MAKINUM(num);
   }
-  else if UNEGFIXABLE(num) return MAKINUM(-(long)num);
+  else if (UNEGFIXABLE(num)) return MAKINUM(-(long)num);
   return b;
 }
 char s_adjbig[] = "adjbig";
@@ -1820,7 +1798,7 @@ SCM normbig(b)
   BIGDIG *zds = BDIGITS(b);
   while (nlen-- && !zds[nlen]); nlen++;
   if (nlen * BITSPERDIG/CHAR_BIT <= sizeof(SCM))
-    if INUMP(b = big2inum(b, (sizet)nlen)) return b;
+    if (INUMP(b = big2inum(b, (sizet)nlen))) return b;
   if (NUMDIGS(b)==nlen) return b;
   return adjbig(b, (sizet)nlen);
 }
@@ -2114,7 +2092,7 @@ SCM divbigbig(x, nx, y, ny, sgn, modes)
  doadj:
   for(j = ny;j && !zds[j-1];--j) ;
   if (j * BITSPERDIG <= sizeof(SCM)*CHAR_BIT)
-    if INUMP(z = big2inum(z, j)) return z;
+    if (INUMP(z = big2inum(z, j))) return z;
   return adjbig(z, j);
 }
 #endif
@@ -2145,7 +2123,6 @@ static iproc subr1s[] = {
 	{s_exactp, exactp},
 	{s_oddp, oddp},
 	{s_evenp, evenp},
-	{s_abs, absval},
 	{s_lognot, scm_lognot},
 	{s_logcount, scm_logcount},
 	{s_intlength, scm_intlength},