Import Upstream version 5e4upstream/5e4

1 files changed, 51 insertions, 25 deletions

diff --git a/subr.c b/subr.c
index 1399939..6703d7c 100644
--- a/subr.c
+++ b/subr.c
@@ -186,7 +186,7 @@ SCM append(args)
 			return res;
 		}
 		ASRTER(CONSP(args), args, ARGn, s_append);
-		for(;NIMP(arg);arg = CDR(arg)) {
+		for (;NIMP(arg);arg = CDR(arg)) {
 			ASRTER(CONSP(arg), arg, ARGn, s_append);
 			*lloc = cons(CAR(arg), EOL);
 			lloc = &CDR(*lloc);
@@ -199,7 +199,7 @@ SCM reverse(lst)
 {
 	SCM res = EOL;
 	SCM p = lst;
-	for(;NIMP(p);p = CDR(p)) {
+	for (;NIMP(p);p = CDR(p)) {
 		ASRTER(CONSP(p), lst, ARG1, s_reverse);
 		res = cons(CAR(p), res);
 	}
@@ -224,7 +224,7 @@ erout:	ASRTER(NIMP(lst) && CONSP(lst),
 SCM memq(x, lst)
      SCM x, lst;
 {
-	for(;NIMP(lst);lst = CDR(lst)) {
+	for (;NIMP(lst);lst = CDR(lst)) {
 		ASRTER(CONSP(lst), lst, ARG2, s_memq);
 		if (CAR(lst)==x) return lst;
 	}
@@ -234,7 +234,7 @@ SCM memq(x, lst)
 SCM member(x, lst)
      SCM x, lst;
 {
-	for(;NIMP(lst);lst = CDR(lst)) {
+	for (;NIMP(lst);lst = CDR(lst)) {
 		ASRTER(CONSP(lst), lst, ARG2, s_member);
 		if (NFALSEP(equal(CAR(lst), x))) return lst;
 	}
@@ -245,7 +245,7 @@ SCM assq(x, alist)
      SCM x, alist;
 {
 	SCM tmp;
-	for(;NIMP(alist);alist = CDR(alist)) {
+	for (;NIMP(alist);alist = CDR(alist)) {
 		ASRTER(CONSP(alist), alist, ARG2, s_assq);
 		tmp = CAR(alist);
 		ASRTER(NIMP(tmp) && CONSP(tmp), alist, ARG2, s_assq);
@@ -258,7 +258,7 @@ SCM assoc(x, alist)
      SCM x, alist;
 {
 	SCM tmp;
-	for(;NIMP(alist);alist = CDR(alist)) {
+	for (;NIMP(alist);alist = CDR(alist)) {
 		ASRTER(CONSP(alist), alist, ARG2, s_assoc);
 		tmp = CAR(alist);
 		ASRTER(NIMP(tmp) && CONSP(tmp), alist, ARG2, s_assoc);
@@ -933,6 +933,7 @@ static char s_logand[] = "logand", s_lognot[] = "lognot",
             s_copybit[] = "copy-bit",
             s_copybitfield[] = "copy-bit-field",
 	    s_ash[] = "ash", s_logcount[] = "logcount",
+	    s_bitwise_bit_count[] = "bitwise-bit-count",
 	    s_intlength[] = "integer-length",
 	    s_bitfield[] = "bit-field",
             s_bitif[] = "bitwise-if";
@@ -1312,7 +1313,7 @@ SCM scm_copybitfield(to, from, rest)
 }
 
 char logtab[] = {0, 1, 1, 2, 1, 2, 2, 3, 1, 2, 2, 3, 2, 3, 3, 4};
-SCM scm_logcount(n)
+SCM scm_bitwise_bit_count(n)
      SCM n;
 {
   register unsigned long c = 0;
@@ -1320,18 +1321,42 @@ SCM scm_logcount(n)
 #ifdef BIGDIG
   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));
+    ASRTER(NIMP(n) && BIGP(n), n, ARG1, s_bitwise_bit_count);
+    if (BIGSIGN(n))
+      return scm_lognot(scm_bitwise_bit_count(difference(MAKINUM(-1L), n)));
     ds = BDIGITS(n);
-    for(i = NUMDIGS(n); i--; )
-      for(d = ds[i]; d; d >>= 4) c += logtab[15 & d];
+    for (i = NUMDIGS(n); i--; )
+      for (d = ds[i]; d; d >>= 4) c += logtab[15 & d];
+    if (BIGSIGN(n))
+      return MAKINUM(-1 - c);
     return MAKINUM(c);
   }
 #else
+  ASRTER(INUMP(n), n, ARG1, s_bitwise_bit_count);
+#endif
+  if ((nn = INUM(n)) < 0) nn = -1 - nn;
+  for (; nn; nn >>= 4) c += logtab[15 & nn];
+  if (n < 0)
+    return MAKINUM(-1 - c);
+  return MAKINUM(c);
+}
+
+SCM scm_logcount(n)
+     SCM n;
+{
+  register unsigned long c = 0;
+  register long nn;
+#ifdef BIGDIG
+  if (NINUMP(n)) {
+    ASRTER(NIMP(n) && BIGP(n), n, ARG1, s_logcount);
+    if (BIGSIGN(n)) return scm_bitwise_bit_count(difference(MAKINUM(-1L), n));
+    return scm_bitwise_bit_count(n);
+  }
+#else
   ASRTER(INUMP(n), n, ARG1, s_logcount);
 #endif
   if ((nn = INUM(n)) < 0) nn = -1 - nn;
-  for(; nn; nn >>= 4) c += logtab[15 & nn];
+  for (; nn; nn >>= 4) c += logtab[15 & nn];
   return MAKINUM(c);
 }
 
@@ -1349,14 +1374,14 @@ SCM scm_intlength(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];}
+    for (c *= BITSPERDIG; d; d >>= 4) {c += 4; l = ilentab[15 & d];}
     return MAKINUM(c - 4 + l);
   }
 #else
   ASRTER(INUMP(n), n, ARG1, s_intlength);
 #endif
   if ((nn = INUM(n)) < 0) nn = -1 - nn;
-  for(;nn; nn >>= 4) {c += 4; l = ilentab[15 & nn];}
+  for (;nn; nn >>= 4) {c += 4; l = ilentab[15 & nn];}
   return MAKINUM(c - 4 + l);
 }
 
@@ -1500,7 +1525,7 @@ SCM string(chrs)
 	ASRTER(i >= 0, chrs, ARG1, s_string);
 	res = makstr(i);
 	data = UCHARS(res);
-	for(;NNULLP(chrs);chrs = CDR(chrs)) {
+	for (;NNULLP(chrs);chrs = CDR(chrs)) {
 		ASRTER(ICHRP(CAR(chrs)), chrs, ARG1, s_string);
 		*data++ = ICHR(CAR(chrs));
 	}
@@ -1518,7 +1543,7 @@ SCM make_string(k, chr)
 	dst = UCHARS(res);
 	if (!UNBNDP(chr)) {
 	  ASRTER(ICHRP(chr), chr, ARG2, s_make_string);
-	  for(i--;i >= 0;i--) dst[i] = ICHR(chr);
+	  for (i--;i >= 0;i--) dst[i] = ICHR(chr);
 	}
 	return res;
 }
@@ -1587,7 +1612,7 @@ SCM st_lessp(s1, s2)
 	if (len>i) i = len;
 	c1 = UCHARS(s1);
 	c2 = UCHARS(s2);
-	for(i = 0;i<len;i++) {
+	for (i = 0;i<len;i++) {
 		c = (*c1++ - *c2++);
 		if (c>0) return BOOL_F;
 		if (c<0) return BOOL_T;
@@ -1622,7 +1647,7 @@ SCM stci_lessp(s1, s2)
 	if (len>i) i=len;
 	c1 = UCHARS(s1);
 	c2 = UCHARS(s2);
-	for(i = 0;i<len;i++) {
+	for (i = 0;i<len;i++) {
 		c = (upcase[*c1++] - upcase[*c2++]);
 		if (c>0) return BOOL_F;
 		if (c<0) return BOOL_T;
@@ -1664,7 +1689,7 @@ SCM st_append(args)
 	register long i = 0;
 	register SCM l, s;
 	register unsigned char *data;
-	for(l = args;NIMP(l);) {
+	for (l = args;NIMP(l);) {
 		ASRTER(CONSP(l), l, ARGn, s_st_append);
 		s = CAR(l);
 		ASRTER(NIMP(s) && STRINGP(s), s, ARGn, s_st_append);
@@ -1674,9 +1699,9 @@ SCM st_append(args)
 	ASRTER(NULLP(l), args, ARGn, s_st_append);
 	res = makstr(i);
 	data = UCHARS(res);
-	for(l = args;NIMP(l);l = CDR(l)) {
+	for (l = args;NIMP(l);l = CDR(l)) {
 		s = CAR(l);
-		for(i = 0;i<LENGTH(s);i++) *data++ = UCHARS(s)[i];
+		for (i = 0;i<LENGTH(s);i++) *data++ = UCHARS(s)[i];
 	}
 	return res;
 }
@@ -1702,7 +1727,7 @@ SCM vector(l)
 	ASRTER(i >= 0, l, ARG1, s_vector);
 	res = make_vector(MAKINUM(i), UNSPECIFIED);
 	data = VELTS(res);
-	for(;NIMP(l);l = CDR(l)) *data++ = CAR(l);
+	for (;NIMP(l);l = CDR(l)) *data++ = CAR(l);
 	return res;
 }
 SCM vector_ref(v, k)
@@ -2073,7 +2098,7 @@ SCM divbigbig(x, nx, y, ny, sgn, modes)
   } while (--j >= ny);
   switch (modes) {
   case 3:			/* check that remainder==0 */
-    for(j = ny;j && !zds[j-1];--j) ; if (j) return 0;
+    for (j = ny;j && !zds[j-1];--j) ; if (j) return 0;
   case 2:			/* move quotient down in z */
     j = (nx==ny ? nx+2 : nx+1) - ny;
     for (i = 0;i < j;i++) zds[i] = zds[i+ny];
@@ -2091,7 +2116,7 @@ SCM divbigbig(x, nx, y, ny, sgn, modes)
     if (d) divbigdig(zds, ny, d);
   }
  doadj:
-  for(j = ny;j && !zds[j-1];--j) ;
+  for (j = ny;j && !zds[j-1];--j) ;
   if (j * BITSPERDIG <= sizeof(SCM)*CHAR_BIT)
     if (INUMP(z = big2inum(z, j))) return z;
   return adjbig(z, j);
@@ -2126,6 +2151,7 @@ static iproc subr1s[] = {
 	{s_evenp, evenp},
 	{s_lognot, scm_lognot},
 	{s_logcount, scm_logcount},
+	{s_bitwise_bit_count, scm_bitwise_bit_count},
 	{s_intlength, scm_intlength},
 	{"char?", charp},
 	{s_ch_alphap, char_alphap},
@@ -2226,7 +2252,7 @@ void init_iprocs(subra, type)
      iproc *subra;
      int type;
 {
-  for(;subra->string; subra++)
+  for (;subra->string; subra++)
     make_subr(subra->string,
 	      type,
 	      subra->cproc);