summaryrefslogtreecommitdiff
path: root/libguile/unif.c
diff options
context:
space:
mode:
authorMichael Livshin <mlivshin@bigfoot.com>2001-05-26 20:51:22 +0000
committerMichael Livshin <mlivshin@bigfoot.com>2001-05-26 20:51:22 +0000
commitc014a02eec7b99c54d8a156ce491ae8d1e341f97 (patch)
treefa7a113564c23215b83e44a1498616a6bf16c853 /libguile/unif.c
parentf3f70257a3befb6495760923d167e52d5cdfddae (diff)
downloadguile-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.c311
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);