diff options
author | Thomas Bushnell <tb@debian.org> | 2007-12-28 15:56:00 -0800 |
---|---|---|
committer | Bryan Newbold <bnewbold@robocracy.org> | 2017-02-20 00:05:38 -0800 |
commit | 967ca9f9b4c42630fb0feb1e5b9186266fa4d854 (patch) | |
tree | 8bbb64f76bd25bf5dc59c856167f46f67cfca2e9 /subr.c | |
parent | 25fbaa7f8700665d5aea046956175a35035f7fd5 (diff) | |
parent | 710a97992705d67c3ded0d4b270c5978ce29b11f (diff) | |
download | scm-967ca9f9b4c42630fb0feb1e5b9186266fa4d854.tar.gz scm-967ca9f9b4c42630fb0feb1e5b9186266fa4d854.zip |
Import Debian changes 5e4-1debian/5e4-1
scm (5e4-1) unstable; urgency=low
* New upstream release.
* debian/control: Require at least version 3a5 of slib.
* debian/postrm: New file to remove /usr/lib/scm/implcat and
/usr/lib/scm/slibcat upon purge. (Closes: #455124). Thanks to Kumar
Appaiah for the fix.
* debian/control (Architecture): Add armel and armeb. (Closes: #408792).
* debian/rules (install): Don't use -s when installing. dh_strip should
be sufficient, and this should make the nostrip build option work.
(Closes: #438004).
* continue.h: Repeat change from 5e1-2.
* xgen.scm: Repeat change from 5e2-4.
* scm.1: Repeat change from 5e2-4.
* build.scm: Repeat change from 5e3-5.
Diffstat (limited to 'subr.c')
-rw-r--r-- | subr.c | 76 |
1 files changed, 51 insertions, 25 deletions
@@ -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); |