summaryrefslogtreecommitdiffstats
path: root/subr.c
diff options
context:
space:
mode:
authorBryan Newbold <bnewbold@robocracy.org>2017-02-20 00:05:37 -0800
committerBryan Newbold <bnewbold@robocracy.org>2017-02-20 00:05:37 -0800
commit710a97992705d67c3ded0d4b270c5978ce29b11f (patch)
treeddcb2f7a91cbb86ce582e74227768b7b898c29e1 /subr.c
parent50eb784bfcf15ee3c6b0b53d747db92673395040 (diff)
downloadscm-710a97992705d67c3ded0d4b270c5978ce29b11f.tar.gz
scm-710a97992705d67c3ded0d4b270c5978ce29b11f.zip
Import Upstream version 5e4upstream/5e4
Diffstat (limited to 'subr.c')
-rw-r--r--subr.c76
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);