diff options
author | Michael Livshin <mlivshin@bigfoot.com> | 2001-05-26 20:51:22 +0000 |
---|---|---|
committer | Michael Livshin <mlivshin@bigfoot.com> | 2001-05-26 20:51:22 +0000 |
commit | c014a02eec7b99c54d8a156ce491ae8d1e341f97 (patch) | |
tree | fa7a113564c23215b83e44a1498616a6bf16c853 /libguile/unif.c | |
parent | f3f70257a3befb6495760923d167e52d5cdfddae (diff) | |
download | guile-c014a02eec7b99c54d8a156ce491ae8d1e341f97.tar.gz |
revert the ill-considered part of the 2001-05-24 changes
Diffstat (limited to 'libguile/unif.c')
-rw-r--r-- | libguile/unif.c | 311 |
1 files changed, 133 insertions, 178 deletions
diff --git a/libguile/unif.c b/libguile/unif.c index aad700af9..fbb9b96d7 100644 --- a/libguile/unif.c +++ b/libguile/unif.c @@ -101,8 +101,6 @@ scm_uniform_element_size (SCM obj) switch (SCM_TYP7 (obj)) { case scm_tc7_bvect: - result = sizeof (scm_bits_t); - break; case scm_tc7_uvect: case scm_tc7_ivect: result = sizeof (long); @@ -156,32 +154,20 @@ singp (SCM obj) } } -#if (SIZEOF_SIZE_T < SCM_SIZEOF_BITS_T) -# define CHECK_BYTE_SIZE(s,k) SCM_ASSERT_RANGE (1, scm_bits2num (k), k <= (size_t)(~(size_t)0)) -#else -# define CHECK_BYTE_SIZE(s,k) -#endif - SCM -scm_make_uve (scm_bits_t k, SCM prot) +scm_make_uve (long k, SCM prot) #define FUNC_NAME "scm_make_uve" { SCM v; - size_t i; - scm_bits_t type; - scm_ubits_t size_in_bytes; + long i, type; if (SCM_EQ_P (prot, SCM_BOOL_T)) { SCM_NEWCELL (v); if (k > 0) { - SCM_ASSERT_RANGE (1, scm_bits2num (k), - k <= SCM_BITVECTOR_MAX_LENGTH); - size_in_bytes = sizeof (scm_bits_t) * ((k + SCM_BITS_LENGTH - 1) / - SCM_BITS_LENGTH); - CHECK_BYTE_SIZE (size_in_bytes, k); - i = (size_t) size_in_bytes; + SCM_ASSERT_RANGE (1, scm_long2num (k), k <= SCM_BITVECTOR_MAX_LENGTH); + i = sizeof (long) * ((k + SCM_LONG_BIT - 1) / SCM_LONG_BIT); SCM_SET_BITVECTOR_BASE (v, (char *) scm_must_malloc (i, "vector")); SCM_SET_BITVECTOR_LENGTH (v, k); } @@ -194,19 +180,17 @@ scm_make_uve (scm_bits_t k, SCM prot) } else if (SCM_CHARP (prot) && (SCM_CHAR (prot) == '\0')) { - size_in_bytes = sizeof (char) * k; + i = sizeof (char) * k; type = scm_tc7_byvect; } else if (SCM_CHARP (prot)) { - size_in_bytes = sizeof (char) * k; - CHECK_BYTE_SIZE (size_in_bytes, k); - i = (size_t) size_in_bytes; + i = sizeof (char) * k; return scm_allocate_string (i); } else if (SCM_INUMP (prot)) { - size_in_bytes = sizeof (long) * k; + i = sizeof (long) * k; if (SCM_INUM (prot) > 0) type = scm_tc7_uvect; else @@ -219,13 +203,13 @@ scm_make_uve (scm_bits_t k, SCM prot) s = SCM_SYMBOL_CHARS (prot)[0]; if (s == 's') { - size_in_bytes = sizeof (short) * k; + i = sizeof (short) * k; type = scm_tc7_svect; } #ifdef HAVE_LONG_LONGS else if (s == 'l') { - size_in_bytes = sizeof (long long) * k; + i = sizeof (long long) * k; type = scm_tc7_llvect; } #endif @@ -233,7 +217,6 @@ scm_make_uve (scm_bits_t k, SCM prot) { return scm_c_make_vector (k, SCM_UNDEFINED); } - } else if (!SCM_INEXACTP (prot)) /* Huge non-unif vectors are NOT supported. */ @@ -241,24 +224,21 @@ scm_make_uve (scm_bits_t k, SCM prot) return scm_c_make_vector (k, SCM_UNDEFINED); else if (singp (prot)) { - size_in_bytes = sizeof (float) * k; + i = sizeof (float) * k; type = scm_tc7_fvect; } else if (SCM_COMPLEXP (prot)) { - size_in_bytes = 2 * sizeof (double) * k; + i = 2 * sizeof (double) * k; type = scm_tc7_cvect; } else { - size_in_bytes = sizeof (double) * k; + i = sizeof (double) * k; type = scm_tc7_dvect; } - CHECK_BYTE_SIZE (size_in_bytes, k); - i = (size_t) size_in_bytes; - - SCM_ASSERT_RANGE (1, scm_bits2num (k), k <= SCM_UVECTOR_MAX_LENGTH); + SCM_ASSERT_RANGE (1, scm_long2num (k), k <= SCM_UVECTOR_MAX_LENGTH); SCM_NEWCELL (v); SCM_DEFER_INTS; @@ -503,14 +483,14 @@ SCM_DEFINE (scm_shared_array_increments, "shared-array-increments", 1, 0, 0, static char s_bad_ind[] = "Bad scm_array index"; -scm_bits_t +long scm_aind (SCM ra, SCM args, const char *what) #define FUNC_NAME what { SCM ind; - register scm_bits_t j; - register scm_bits_t pos = SCM_ARRAY_BASE (ra); - register size_t k = SCM_ARRAY_NDIM (ra); + register long j; + register unsigned long pos = SCM_ARRAY_BASE (ra); + register unsigned long k = SCM_ARRAY_NDIM (ra); scm_array_dim_t *s = SCM_ARRAY_DIMS (ra); if (SCM_INUMP (args)) { @@ -608,7 +588,7 @@ SCM_DEFINE (scm_dimensions_to_uniform_array, "dimensions->uniform-array", 2, 1, #define FUNC_NAME s_scm_dimensions_to_uniform_array { size_t k; - scm_bits_t rlen = 1; + unsigned long rlen = 1; scm_array_dim_t *s; SCM ra; @@ -634,7 +614,6 @@ SCM_DEFINE (scm_dimensions_to_uniform_array, "dimensions->uniform-array", 2, 1, while (k--) { s[k].inc = rlen; - SCM_ASSERT_RANGE (1, dims, s[k].inc >= 0); SCM_ASSERT_RANGE (1, dims, s[k].lbnd <= s[k].ubnd); rlen = (s[k].ubnd - s[k].lbnd + 1) * s[k].inc; } @@ -649,7 +628,7 @@ SCM_DEFINE (scm_dimensions_to_uniform_array, "dimensions->uniform-array", 2, 1, scm_array_fill_x (ra, prot); if (1 == SCM_ARRAY_NDIM (ra) && 0 == SCM_ARRAY_BASE (ra)) - if (s[0].ubnd < s[0].lbnd || (0 == s[0].lbnd && 1 == s[0].inc)) + if (s->ubnd < s->lbnd || (0 == s->lbnd && 1 == s->inc)) return SCM_ARRAY_V (ra); return ra; } @@ -662,7 +641,7 @@ scm_ra_set_contp (SCM ra) size_t k = SCM_ARRAY_NDIM (ra); if (k) { - scm_bits_t inc = SCM_ARRAY_DIMS (ra)[k - 1].inc; /*??*/ + long inc = SCM_ARRAY_DIMS (ra)[k - 1].inc; while (k--) { if (inc != SCM_ARRAY_DIMS (ra)[k].inc) @@ -700,9 +679,8 @@ SCM_DEFINE (scm_make_shared_array, "make-shared-array", 2, 0, 1, SCM ra; SCM inds, indptr; SCM imap; - size_t k; - scm_bits_t i; - scm_bits_t old_min, new_min, old_max, new_max; + size_t k, i; + long old_min, new_min, old_max, new_max; scm_array_dim_t *s; SCM_VALIDATE_REST_ARGUMENT (dims); @@ -745,7 +723,7 @@ SCM_DEFINE (scm_make_shared_array, "make-shared-array", 2, 0, 1, } imap = scm_apply (mapfunc, scm_reverse (inds), SCM_EOL); if (SCM_ARRAYP (oldra)) - i = scm_aind (oldra, imap, FUNC_NAME); + i = (size_t) scm_aind (oldra, imap, FUNC_NAME); else { if (SCM_NINUMP (imap)) @@ -794,7 +772,7 @@ SCM_DEFINE (scm_make_shared_array, "make-shared-array", 2, 0, 1, if (1 == SCM_ARRAY_NDIM (ra) && 0 == SCM_ARRAY_BASE (ra)) { SCM v = SCM_ARRAY_V (ra); - scm_bits_t length = SCM_INUM (scm_uniform_vector_length (v)); + unsigned long int length = SCM_INUM (scm_uniform_vector_length (v)); if (1 == s->inc && 0 == s->lbnd && length == 1 + s->ubnd) return v; if (s->ubnd < s->lbnd) @@ -1024,9 +1002,9 @@ SCM_DEFINE (scm_array_in_bounds_p, "array-in-bounds?", 1, 0, 1, #define FUNC_NAME s_scm_array_in_bounds_p { SCM ind = SCM_EOL; - scm_bits_t pos = 0; + long pos = 0; register size_t k; - register scm_bits_t j; + register long j; scm_array_dim_t *s; SCM_VALIDATE_REST_ARGUMENT (args); @@ -1090,7 +1068,7 @@ tail: case scm_tc7_vector: case scm_tc7_wvect: { - scm_bits_t length = SCM_INUM (scm_uniform_vector_length (v)); + unsigned long int length = SCM_INUM (scm_uniform_vector_length (v)); SCM_ASRTGO (SCM_NULLP (args) && SCM_INUMP (ind), wna); return SCM_BOOL(pos >= 0 && pos < length); } @@ -1109,7 +1087,7 @@ SCM_DEFINE (scm_uniform_vector_ref, "uniform-vector-ref", 2, 0, 0, "@var{array}.") #define FUNC_NAME s_scm_uniform_vector_ref { - scm_bits_t pos; + long pos; if (SCM_IMP (v)) { @@ -1123,7 +1101,7 @@ SCM_DEFINE (scm_uniform_vector_ref, "uniform-vector-ref", 2, 0, 0, } else { - scm_bits_t length; + unsigned long int length; if (SCM_NIMP (args)) { SCM_ASSERT (SCM_CONSP (args) && SCM_INUMP (SCM_CAR (args)), args, SCM_ARG2, FUNC_NAME); @@ -1204,7 +1182,7 @@ SCM_DEFINE (scm_uniform_vector_ref, "uniform-vector-ref", 2, 0, 0, tries to recycle conses. (Make *sure* you want them recycled.) */ SCM -scm_cvref (SCM v, scm_bits_t pos, SCM last) +scm_cvref (SCM v, unsigned long pos, SCM last) #define FUNC_NAME "scm_cvref" { switch SCM_TYP7 (v) @@ -1287,7 +1265,7 @@ SCM_DEFINE (scm_array_set_x, "array-set!", 2, 0, 1, "@var{new-value}. The value returned by array-set! is unspecified.") #define FUNC_NAME s_scm_array_set_x { - scm_bits_t pos = 0; + long pos = 0; SCM_VALIDATE_REST_ARGUMENT (args); SCM_ASRTGO (SCM_NIMP (v), badarg1); @@ -1298,7 +1276,7 @@ SCM_DEFINE (scm_array_set_x, "array-set!", 2, 0, 1, } else { - scm_bits_t length; + unsigned long int length; if (SCM_NIMP (args)) { SCM_ASSERT (SCM_CONSP(args) && SCM_INUMP (SCM_CAR (args)), args, @@ -1426,8 +1404,7 @@ SCM_DEFINE (scm_array_contents, "array-contents", 1, 1, 0, return ra; case scm_tc7_smob: { - size_t k, ndim = SCM_ARRAY_NDIM (ra); - scm_bits_t len = 1; + size_t k, ndim = SCM_ARRAY_NDIM (ra), len = 1; if (!SCM_ARRAYP (ra) || !SCM_ARRAY_CONTP (ra)) return SCM_BOOL_F; for (k = 0; k < ndim; k++) @@ -1439,15 +1416,15 @@ SCM_DEFINE (scm_array_contents, "array-contents", 1, 1, 0, if (scm_tc7_bvect == SCM_TYP7 (SCM_ARRAY_V (ra))) { if (len != SCM_BITVECTOR_LENGTH (SCM_ARRAY_V (ra)) || - SCM_ARRAY_BASE (ra) % SCM_BITS_LENGTH || - len % SCM_BITS_LENGTH) + SCM_ARRAY_BASE (ra) % SCM_LONG_BIT || + len % SCM_LONG_BIT) return SCM_BOOL_F; } } { SCM v = SCM_ARRAY_V (ra); - scm_bits_t length = SCM_INUM (scm_uniform_vector_length (v)); + unsigned long int length = SCM_INUM (scm_uniform_vector_length (v)); if ((len == length) && 0 == SCM_ARRAY_BASE (ra) && SCM_ARRAY_DIMS (ra)->inc) return v; } @@ -1469,9 +1446,8 @@ SCM scm_ra2contig (SCM ra, int copy) { SCM ret; - scm_bits_t inc = 1; - size_t k; - scm_bits_t len = 1; + long inc = 1; + size_t k, len = 1; for (k = SCM_ARRAY_NDIM (ra); k--;) len *= SCM_ARRAY_DIMS (ra)[k].ubnd - SCM_ARRAY_DIMS (ra)[k].lbnd + 1; k = SCM_ARRAY_NDIM (ra); @@ -1480,8 +1456,8 @@ scm_ra2contig (SCM ra, int copy) if (scm_tc7_bvect != SCM_TYP7 (SCM_ARRAY_V (ra))) return ra; if ((len == SCM_BITVECTOR_LENGTH (SCM_ARRAY_V (ra)) && - 0 == SCM_ARRAY_BASE (ra) % SCM_BITS_LENGTH && - 0 == len % SCM_BITS_LENGTH)) + 0 == SCM_ARRAY_BASE (ra) % SCM_LONG_BIT && + 0 == len % SCM_LONG_BIT)) return ra; } ret = scm_make_ra (k); @@ -1519,10 +1495,10 @@ SCM_DEFINE (scm_uniform_array_read_x, "uniform-array-read!", 1, 3, 0, #define FUNC_NAME s_scm_uniform_array_read_x { SCM cra = SCM_UNDEFINED, v = ra; - int sz; - scm_bits_t vlen, ans; - scm_bits_t cstart = 0, cend = 0; - scm_bits_t offset = 0; + long sz, vlen, ans; + long cstart = 0; + long cend; + long offset = 0; char *base; SCM_ASRTGO (SCM_NIMP (v), badarg1); @@ -1553,9 +1529,9 @@ loop: break; case scm_tc7_bvect: base = (char *) SCM_BITVECTOR_BASE (v); - vlen = (vlen + SCM_BITS_LENGTH - 1) / SCM_BITS_LENGTH; - cstart /= SCM_BITS_LENGTH; - sz = sizeof (scm_bits_t); + vlen = (vlen + SCM_LONG_BIT - 1) / SCM_LONG_BIT; + cstart /= SCM_LONG_BIT; + sz = sizeof (long); break; case scm_tc7_byvect: base = (char *) SCM_UVECTOR_BASE (v); @@ -1594,15 +1570,15 @@ loop: if (!SCM_UNBNDP (start)) { offset = - SCM_NUM2BITS (3, start); + SCM_NUM2LONG (3, start); if (offset < 0 || offset >= cend) scm_out_of_range (FUNC_NAME, start); if (!SCM_UNBNDP (end)) { - scm_bits_t tend = - SCM_NUM2BITS (4, end); + long tend = + SCM_NUM2LONG (4, end); if (tend <= offset || tend > cend) scm_out_of_range (FUNC_NAME, end); @@ -1658,7 +1634,7 @@ loop: SCM_SYSERROR; } if (SCM_TYP7 (v) == scm_tc7_bvect) - ans *= SCM_BITS_LENGTH; + ans *= SCM_LONG_BIT; if (!SCM_EQ_P (v, ra) && !SCM_EQ_P (cra, ra)) scm_array_copy_x (cra, ra); @@ -1681,9 +1657,10 @@ SCM_DEFINE (scm_uniform_array_write, "uniform-array-write", 1, 3, 0, "@code{(current-output-port)}.") #define FUNC_NAME s_scm_uniform_array_write { - int sz; - scm_bits_t vlen, ans; - scm_bits_t offset = 0, cstart = 0, cend; + long sz, vlen, ans; + long offset = 0; + long cstart = 0; + long cend; char *base; port_or_fd = SCM_COERCE_OUTPORT (port_or_fd); @@ -1716,9 +1693,9 @@ loop: break; case scm_tc7_bvect: base = (char *) SCM_BITVECTOR_BASE (v); - vlen = (vlen + SCM_BITS_LENGTH - 1) / SCM_BITS_LENGTH; - cstart /= SCM_BITS_LENGTH; - sz = sizeof (scm_bits_t); + vlen = (vlen + SCM_LONG_BIT - 1) / SCM_LONG_BIT; + cstart /= SCM_LONG_BIT; + sz = sizeof (long); break; case scm_tc7_byvect: base = (char *) SCM_UVECTOR_BASE (v); @@ -1757,15 +1734,15 @@ loop: if (!SCM_UNBNDP (start)) { offset = - SCM_NUM2BITS (3, start); + SCM_NUM2LONG (3, start); if (offset < 0 || offset >= cend) scm_out_of_range (FUNC_NAME, start); if (!SCM_UNBNDP (end)) { - scm_bits_t tend = - SCM_NUM2BITS (4, end); + long tend = + SCM_NUM2LONG (4, end); if (tend <= offset || tend > cend) scm_out_of_range (FUNC_NAME, end); @@ -1789,7 +1766,7 @@ loop: SCM_SYSERROR; } if (SCM_TYP7 (v) == scm_tc7_bvect) - ans *= SCM_BITS_LENGTH; + ans *= SCM_LONG_BIT; return SCM_MAKINUM (ans); } @@ -1810,13 +1787,13 @@ SCM_DEFINE (scm_bit_count, "bit-count", 2, 0, 0, if (SCM_BITVECTOR_LENGTH (bitvector) == 0) { return SCM_INUM0; } else { - scm_bits_t count = 0; - size_t i = (SCM_BITVECTOR_LENGTH (bitvector) - 1) / SCM_BITS_LENGTH; - scm_ubits_t w = SCM_UNPACK (SCM_VELTS (bitvector)[i]); + unsigned long int count = 0; + unsigned long int i = (SCM_BITVECTOR_LENGTH (bitvector) - 1) / SCM_LONG_BIT; + unsigned long int w = SCM_UNPACK (SCM_VELTS (bitvector)[i]); if (SCM_FALSEP (b)) { w = ~w; }; - w <<= SCM_BITS_LENGTH - 1 - ((SCM_BITVECTOR_LENGTH (bitvector) - 1) % SCM_BITS_LENGTH); + w <<= SCM_LONG_BIT - 1 - ((SCM_BITVECTOR_LENGTH (bitvector) - 1) % SCM_LONG_BIT); while (1) { while (w) { count += cnt_tab[w & 0x0f]; @@ -1844,11 +1821,8 @@ SCM_DEFINE (scm_bit_position, "bit-position", 3, 0, 0, "within the specified range @code{#f} is returned.") #define FUNC_NAME s_scm_bit_position { - size_t i; - scm_bits_t pos; - size_t lenw; - int xbits; - register scm_ubits_t w; + long i, lenw, xbits, pos; + register unsigned long w; SCM_VALIDATE_BOOL (1, item); SCM_ASSERT (SCM_BITVECTOR_P (v), v, SCM_ARG2, FUNC_NAME); @@ -1858,15 +1832,15 @@ SCM_DEFINE (scm_bit_position, "bit-position", 3, 0, 0, if (pos == SCM_BITVECTOR_LENGTH (v)) return SCM_BOOL_F; - lenw = (SCM_BITVECTOR_LENGTH (v) - 1) / SCM_BITS_LENGTH; /* watch for part words */ - i = pos / SCM_BITS_LENGTH; + lenw = (SCM_BITVECTOR_LENGTH (v) - 1) / SCM_LONG_BIT; /* watch for part words */ + i = pos / SCM_LONG_BIT; w = SCM_UNPACK (SCM_VELTS (v)[i]); if (SCM_FALSEP (item)) w = ~w; - xbits = (pos % SCM_BITS_LENGTH); + xbits = (pos % SCM_LONG_BIT); pos -= xbits; w = ((w >> xbits) << xbits); - xbits = SCM_BITS_LENGTH - 1 - (SCM_BITVECTOR_LENGTH (v) - 1) % SCM_BITS_LENGTH; + xbits = SCM_LONG_BIT - 1 - (SCM_BITVECTOR_LENGTH (v) - 1) % SCM_LONG_BIT; while (!0) { if (w && (i == lenw)) @@ -1893,7 +1867,7 @@ SCM_DEFINE (scm_bit_position, "bit-position", 3, 0, 0, } if (++i > lenw) break; - pos += SCM_BITS_LENGTH; + pos += SCM_LONG_BIT; w = SCM_UNPACK (SCM_VELTS (v)[i]); if (SCM_FALSEP (item)) w = ~w; @@ -1915,8 +1889,7 @@ SCM_DEFINE (scm_bit_set_star_x, "bit-set*!", 3, 0, 0, "@var{bool}. The return value is unspecified.") #define FUNC_NAME s_scm_bit_set_star_x { - register size_t i; - scm_bits_t vlen; + register long i, k, vlen; SCM_ASSERT (SCM_BITVECTOR_P (v), v, SCM_ARG1, FUNC_NAME); SCM_ASRTGO (SCM_NIMP (kv), badarg2); switch SCM_TYP7 (kv) @@ -1924,13 +1897,11 @@ SCM_DEFINE (scm_bit_set_star_x, "bit-set*!", 3, 0, 0, default: badarg2:SCM_WRONG_TYPE_ARG (2, kv); case scm_tc7_uvect: - { - unsigned long k; vlen = SCM_BITVECTOR_LENGTH (v); if (SCM_FALSEP (obj)) for (i = SCM_UVECTOR_LENGTH (kv); i;) { - k = ((unsigned long *) SCM_VELTS (kv))[--i]; + k = SCM_UNPACK (SCM_VELTS (kv)[--i]); if (k >= vlen) scm_out_of_range (FUNC_NAME, SCM_MAKINUM (k)); SCM_BITVEC_CLR(v,k); @@ -1938,7 +1909,7 @@ SCM_DEFINE (scm_bit_set_star_x, "bit-set*!", 3, 0, 0, else if (SCM_EQ_P (obj, SCM_BOOL_T)) for (i = SCM_UVECTOR_LENGTH (kv); i;) { - k = ((unsigned long *) SCM_VELTS (kv))[--i]; + k = SCM_UNPACK (SCM_VELTS (kv)[--i]); if (k >= vlen) scm_out_of_range (FUNC_NAME, SCM_MAKINUM (k)); SCM_BITVEC_SET(v,k); @@ -1946,22 +1917,18 @@ SCM_DEFINE (scm_bit_set_star_x, "bit-set*!", 3, 0, 0, else badarg3:SCM_WRONG_TYPE_ARG (3, obj); break; - } case scm_tc7_bvect: - { - scm_ubits_t k; SCM_ASSERT (SCM_BITVECTOR_LENGTH (v) == SCM_BITVECTOR_LENGTH (kv), v, SCM_ARG1, FUNC_NAME); if (SCM_FALSEP (obj)) - for (k = (SCM_BITVECTOR_LENGTH (v) + SCM_BITS_LENGTH - 1) / SCM_BITS_LENGTH; k--;) - ((scm_ubits_t *) SCM_VELTS (v))[k] &= ~ ((scm_ubits_t *) SCM_VELTS (kv))[k]; + for (k = (SCM_BITVECTOR_LENGTH (v) + SCM_LONG_BIT - 1) / SCM_LONG_BIT; k--;) + SCM_UNPACK (SCM_VELTS (v)[k]) &= ~ SCM_UNPACK(SCM_VELTS (kv)[k]); else if (SCM_EQ_P (obj, SCM_BOOL_T)) - for (k = (SCM_BITVECTOR_LENGTH (v) + SCM_BITS_LENGTH - 1) / SCM_BITS_LENGTH; k--;) - ((scm_ubits_t *) SCM_VELTS (v))[k] |= ((scm_ubits_t *) SCM_VELTS (kv))[k]; + for (k = (SCM_BITVECTOR_LENGTH (v) + SCM_LONG_BIT - 1) / SCM_LONG_BIT; k--;) + SCM_UNPACK (SCM_VELTS (v)[k]) |= SCM_UNPACK (SCM_VELTS (kv)[k]); else goto badarg3; break; } - } return SCM_UNSPECIFIED; } #undef FUNC_NAME @@ -1976,8 +1943,8 @@ SCM_DEFINE (scm_bit_count_star, "bit-count*", 3, 0, 0, "@var{bv} is not modified.") #define FUNC_NAME s_scm_bit_count_star { - register size_t i; - scm_bits_t vlen, count = 0; + register long i, vlen, count = 0; + register unsigned long k; int fObj = 0; SCM_ASSERT (SCM_BITVECTOR_P (v), v, SCM_ARG1, FUNC_NAME); @@ -1988,13 +1955,11 @@ SCM_DEFINE (scm_bit_count_star, "bit-count*", 3, 0, 0, badarg2: SCM_WRONG_TYPE_ARG (2, kv); case scm_tc7_uvect: - { - unsigned long k; vlen = SCM_BITVECTOR_LENGTH (v); if (SCM_FALSEP (obj)) for (i = SCM_UVECTOR_LENGTH (kv); i;) { - k = ((unsigned long *) SCM_VELTS (kv))[--i]; + k = SCM_UNPACK (SCM_VELTS (kv)[--i]); if (k >= vlen) scm_out_of_range (FUNC_NAME, SCM_MAKINUM (k)); if (!SCM_BITVEC_REF(v,k)) @@ -2003,7 +1968,7 @@ SCM_DEFINE (scm_bit_count_star, "bit-count*", 3, 0, 0, else if (SCM_EQ_P (obj, SCM_BOOL_T)) for (i = SCM_UVECTOR_LENGTH (kv); i;) { - k = ((unsigned long *) SCM_VELTS (kv))[--i]; + k = SCM_UNPACK (SCM_VELTS (kv)[--i]); if (k >= vlen) scm_out_of_range (FUNC_NAME, SCM_MAKINUM (k)); if (SCM_BITVEC_REF (v,k)) @@ -2012,20 +1977,15 @@ SCM_DEFINE (scm_bit_count_star, "bit-count*", 3, 0, 0, else badarg3:SCM_WRONG_TYPE_ARG (3, obj); break; - } case scm_tc7_bvect: - { - scm_ubits_t k; SCM_ASSERT (SCM_BITVECTOR_LENGTH (v) == SCM_BITVECTOR_LENGTH (kv), v, SCM_ARG1, FUNC_NAME); if (0 == SCM_BITVECTOR_LENGTH (v)) return SCM_INUM0; SCM_ASRTGO (SCM_BOOLP (obj), badarg3); fObj = SCM_EQ_P (obj, SCM_BOOL_T); - i = (SCM_BITVECTOR_LENGTH (v) - 1) / SCM_BITS_LENGTH; - k = - ((scm_ubits_t *) SCM_VELTS (kv))[i] - & (fObj ? ((scm_ubits_t *) SCM_VELTS (v))[i] : ~ ((scm_ubits_t *) SCM_VELTS (v))[i]); - k <<= SCM_BITS_LENGTH - 1 - ((SCM_BITVECTOR_LENGTH (v) - 1) % SCM_BITS_LENGTH); + i = (SCM_BITVECTOR_LENGTH (v) - 1) / SCM_LONG_BIT; + k = SCM_UNPACK (SCM_VELTS (kv)[i]) & (fObj ? SCM_UNPACK (SCM_VELTS (v)[i]) : ~ SCM_UNPACK (SCM_VELTS (v)[i])); + k <<= SCM_LONG_BIT - 1 - ((SCM_BITVECTOR_LENGTH (v) - 1) % SCM_LONG_BIT); while (1) { for (; k; k >>= 4) @@ -2034,10 +1994,7 @@ SCM_DEFINE (scm_bit_count_star, "bit-count*", 3, 0, 0, return SCM_MAKINUM (count); /* urg. repetitive (see above.) */ - k = - ((scm_ubits_t *) SCM_VELTS (kv))[i] - & (fObj ? ((scm_ubits_t *) SCM_VELTS (v))[i] : ~ ((scm_ubits_t *) SCM_VELTS (v))[i]); - } + k = SCM_UNPACK (SCM_VELTS (kv)[i]) & (fObj ? SCM_UNPACK(SCM_VELTS (v)[i]) : ~SCM_UNPACK (SCM_VELTS (v)[i])); } } return SCM_MAKINUM (count); @@ -2050,13 +2007,13 @@ SCM_DEFINE (scm_bit_invert_x, "bit-invert!", 1, 0, 0, "Modifies @var{bv} by replacing each element with its negation.") #define FUNC_NAME s_scm_bit_invert_x { - scm_bits_t k; + long int k; SCM_ASSERT (SCM_BITVECTOR_P (v), v, SCM_ARG1, FUNC_NAME); k = SCM_BITVECTOR_LENGTH (v); - for (k = (k + SCM_BITS_LENGTH - 1) / SCM_BITS_LENGTH; k--;) - ((scm_ubits_t *) SCM_VELTS (v))[k] = ~((scm_ubits_t *) SCM_VELTS (v))[k]; + for (k = (k + SCM_LONG_BIT - 1) / SCM_LONG_BIT; k--;) + SCM_UNPACK (SCM_VELTS (v)[k]) = ~SCM_UNPACK (SCM_VELTS (v)[k]); return SCM_UNSPECIFIED; } @@ -2064,19 +2021,19 @@ SCM_DEFINE (scm_bit_invert_x, "bit-invert!", 1, 0, 0, SCM -scm_istr2bve (char *str, scm_bits_t len) +scm_istr2bve (char *str, long len) { SCM v = scm_make_uve (len, SCM_BOOL_T); - scm_ubits_t *data = (scm_ubits_t *) SCM_VELTS (v); - register scm_bits_t mask; - register size_t k; - register int j; - for (k = 0; k < (len + SCM_BITS_LENGTH - 1) / SCM_BITS_LENGTH; k++) + long *data = (long *) SCM_VELTS (v); + register unsigned long mask; + register long k; + register long j; + for (k = 0; k < (len + SCM_LONG_BIT - 1) / SCM_LONG_BIT; k++) { data[k] = 0L; - j = len - k * SCM_BITS_LENGTH; - if (j > SCM_BITS_LENGTH) - j = SCM_BITS_LENGTH; + j = len - k * SCM_LONG_BIT; + if (j > SCM_LONG_BIT) + j = SCM_LONG_BIT; for (mask = 1L; j--; mask <<= 1) switch (*str++) { @@ -2095,11 +2052,11 @@ scm_istr2bve (char *str, scm_bits_t len) static SCM -ra2l (SCM ra, scm_bits_t base, size_t k) +ra2l (SCM ra,unsigned long base,unsigned long k) { register SCM res = SCM_EOL; - register scm_bits_t inc = SCM_ARRAY_DIMS (ra)[k].inc; - register scm_bits_t i; + register long inc = SCM_ARRAY_DIMS (ra)[k].inc; + register size_t i; if (SCM_ARRAY_DIMS (ra)[k].ubnd < SCM_ARRAY_DIMS (ra)[k].lbnd) return SCM_EOL; i = base + (1 + SCM_ARRAY_DIMS (ra)[k].ubnd - SCM_ARRAY_DIMS (ra)[k].lbnd) * inc; @@ -2130,7 +2087,7 @@ SCM_DEFINE (scm_array_to_list, "array->list", 1, 0, 0, #define FUNC_NAME s_scm_array_to_list { SCM res = SCM_EOL; - register size_t k; + register long k; SCM_ASRTGO (SCM_NIMP (v), badarg1); switch SCM_TYP7 (v) { @@ -2146,35 +2103,35 @@ SCM_DEFINE (scm_array_to_list, "array->list", 1, 0, 0, return scm_string_to_list (v); case scm_tc7_bvect: { - scm_ubits_t *data = (scm_ubits_t *) SCM_VELTS (v); - register scm_ubits_t mask; - for (k = (SCM_BITVECTOR_LENGTH (v) - 1) / SCM_BITS_LENGTH; k > 0; k--) - for (mask = 1UL << (SCM_BITS_LENGTH - 1); mask; mask >>= 1) - res = scm_cons (SCM_BOOL(data[k] & mask), res); - for (mask = 1L << ((SCM_BITVECTOR_LENGTH (v) % SCM_BITS_LENGTH) - 1); mask; mask >>= 1) - res = scm_cons (SCM_BOOL(data[k] & mask), res); + long *data = (long *) SCM_VELTS (v); + register unsigned long mask; + for (k = (SCM_BITVECTOR_LENGTH (v) - 1) / SCM_LONG_BIT; k > 0; k--) + for (mask = 1UL << (SCM_LONG_BIT - 1); mask; mask >>= 1) + res = scm_cons (SCM_BOOL(((long *) data)[k] & mask), res); + for (mask = 1L << ((SCM_BITVECTOR_LENGTH (v) % SCM_LONG_BIT) - 1); mask; mask >>= 1) + res = scm_cons (SCM_BOOL(((long *) data)[k] & mask), res); return res; } case scm_tc7_byvect: { signed char *data = (signed char *) SCM_VELTS (v); - scm_bits_t k = SCM_UVECTOR_LENGTH (v); + unsigned long k = SCM_UVECTOR_LENGTH (v); while (k != 0) res = scm_cons (SCM_MAKINUM (data[--k]), res); return res; } case scm_tc7_uvect: { - scm_ubits_t *data = (scm_ubits_t *) SCM_VELTS(v); + long *data = (long *)SCM_VELTS(v); for (k = SCM_UVECTOR_LENGTH(v) - 1; k >= 0; k--) - res = scm_cons(scm_ubits2num(data[k]), res); + res = scm_cons(scm_ulong2num(data[k]), res); return res; } case scm_tc7_ivect: { - scm_bits_t *data = (scm_bits_t *) SCM_VELTS(v); + long *data = (long *)SCM_VELTS(v); for (k = SCM_UVECTOR_LENGTH(v) - 1; k >= 0; k--) - res = scm_cons(scm_bits2num(data[k]), res); + res = scm_cons(scm_long2num(data[k]), res); return res; } case scm_tc7_svect: @@ -2219,7 +2176,7 @@ SCM_DEFINE (scm_array_to_list, "array->list", 1, 0, 0, #undef FUNC_NAME -static int l2ra (SCM lst, SCM ra, scm_bits_t base, size_t k); +static int l2ra(SCM lst, SCM ra, unsigned long base, unsigned long k); SCM_DEFINE (scm_list_to_uniform_array, "list->uniform-array", 3, 0, 0, (SCM ndim, SCM prot, SCM lst), @@ -2233,7 +2190,7 @@ SCM_DEFINE (scm_list_to_uniform_array, "list->uniform-array", 3, 0, 0, SCM shp = SCM_EOL; SCM row = lst; SCM ra; - scm_bits_t k; + unsigned long k; long n; SCM_VALIDATE_INUM_COPY (1,ndim,k); while (k--) @@ -2254,7 +2211,7 @@ SCM_DEFINE (scm_list_to_uniform_array, "list->uniform-array", 3, 0, 0, } if (!SCM_ARRAYP (ra)) { - scm_bits_t length = SCM_INUM (scm_uniform_vector_length (ra)); + unsigned long int length = SCM_INUM (scm_uniform_vector_length (ra)); for (k = 0; k < length; k++, lst = SCM_CDR (lst)) scm_array_set_x (ra, SCM_CAR (lst), SCM_MAKINUM (k)); return ra; @@ -2267,10 +2224,10 @@ SCM_DEFINE (scm_list_to_uniform_array, "list->uniform-array", 3, 0, 0, #undef FUNC_NAME static int -l2ra (SCM lst, SCM ra, scm_bits_t base, size_t k) +l2ra (SCM lst, SCM ra, unsigned long base, unsigned long k) { - register scm_bits_t inc = SCM_ARRAY_DIMS (ra)[k].inc; - register scm_bits_t n = (1 + SCM_ARRAY_DIMS (ra)[k].ubnd - SCM_ARRAY_DIMS (ra)[k].lbnd); + register long inc = SCM_ARRAY_DIMS (ra)[k].inc; + register long n = (1 + SCM_ARRAY_DIMS (ra)[k].ubnd - SCM_ARRAY_DIMS (ra)[k].lbnd); int ok = 1; if (n <= 0) return (SCM_NULLP (lst)); @@ -2305,10 +2262,10 @@ l2ra (SCM lst, SCM ra, scm_bits_t base, size_t k) static void -rapr1 (SCM ra, scm_bits_t j, size_t k, SCM port, scm_print_state *pstate) +rapr1 (SCM ra,unsigned long j,unsigned long k,SCM port,scm_print_state *pstate) { - scm_bits_t inc = 1; - scm_bits_t n = (SCM_TYP7 (ra) == scm_tc7_smob + long inc = 1; + long n = (SCM_TYP7 (ra) == scm_tc7_smob ? 0 : SCM_INUM (scm_uniform_vector_length (ra))); int enclosed = 0; @@ -2331,7 +2288,7 @@ tail: } if (k + 1 < SCM_ARRAY_NDIM (ra)) { - scm_bits_t i; + long i; inc = SCM_ARRAY_DIMS (ra)[k].inc; for (i = SCM_ARRAY_DIMS (ra)[k].lbnd; i < SCM_ARRAY_DIMS (ra)[k].ubnd; i++) { @@ -2484,7 +2441,7 @@ int scm_raprin1 (SCM exp, SCM port, scm_print_state *pstate) { SCM v = exp; - scm_bits_t base = 0; + unsigned long base = 0; scm_putc ('#', port); tail: switch SCM_TYP7 (v) @@ -2511,23 +2468,21 @@ tail: case scm_tc7_bvect: if (SCM_EQ_P (exp, v)) { /* a uve, not an scm_array */ - register size_t i; - register int j; - scm_ubits_t w; + register long i, j, w; scm_putc ('*', port); - for (i = 0; i < (SCM_BITVECTOR_LENGTH (exp) / SCM_BITS_LENGTH); i++) + for (i = 0; i < (SCM_BITVECTOR_LENGTH (exp)) / SCM_LONG_BIT; i++) { - w = SCM_UNPACK (SCM_VELTS (exp)[i]); - for (j = SCM_BITS_LENGTH; j; j--) + scm_bits_t w = SCM_UNPACK (SCM_VELTS (exp)[i]); + for (j = SCM_LONG_BIT; j; j--) { scm_putc (w & 1 ? '1' : '0', port); w >>= 1; } } - j = SCM_BITVECTOR_LENGTH (exp) % SCM_BITS_LENGTH; + j = SCM_BITVECTOR_LENGTH (exp) % SCM_LONG_BIT; if (j) { - w = SCM_UNPACK (SCM_VELTS (exp)[SCM_BITVECTOR_LENGTH (exp) / SCM_BITS_LENGTH]); + w = SCM_UNPACK (SCM_VELTS (exp)[SCM_BITVECTOR_LENGTH (exp) / SCM_LONG_BIT]); for (; j; j--) { scm_putc (w & 1 ? '1' : '0', port); |