summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--libguile/ramap.c390
-rw-r--r--libguile/srfi-4.c24
-rw-r--r--libguile/srfi-4.i.c4
-rw-r--r--libguile/unif.c370
-rw-r--r--libguile/unif.h50
-rw-r--r--libguile/vectors.c24
6 files changed, 436 insertions, 426 deletions
diff --git a/libguile/ramap.c b/libguile/ramap.c
index 513fa2f41..4a02bcb4b 100644
--- a/libguile/ramap.c
+++ b/libguile/ramap.c
@@ -84,11 +84,11 @@ cind (SCM ra, long *ve)
{
unsigned long i;
int k;
- if (!SCM_ARRAYP (ra))
+ if (!SCM_I_ARRAYP (ra))
return *ve;
- i = SCM_ARRAY_BASE (ra);
- for (k = 0; k < SCM_ARRAY_NDIM (ra); k++)
- i += (ve[k] - SCM_ARRAY_DIMS (ra)[k].lbnd) * SCM_ARRAY_DIMS (ra)[k].inc;
+ i = SCM_I_ARRAY_BASE (ra);
+ for (k = 0; k < SCM_I_ARRAY_NDIM (ra); k++)
+ i += (ve[k] - SCM_I_ARRAY_DIMS (ra)[k].lbnd) * SCM_I_ARRAY_DIMS (ra)[k].inc;
return i;
}
@@ -118,11 +118,11 @@ scm_ra_matchp (SCM ra0, SCM ras)
s0->inc = 1;
s0->ubnd = scm_c_generalized_vector_length (ra0) - 1;
}
- else if (SCM_ARRAYP (ra0))
+ else if (SCM_I_ARRAYP (ra0))
{
- ndim = SCM_ARRAY_NDIM (ra0);
- s0 = SCM_ARRAY_DIMS (ra0);
- bas0 = SCM_ARRAY_BASE (ra0);
+ ndim = SCM_I_ARRAY_NDIM (ra0);
+ s0 = SCM_I_ARRAY_DIMS (ra0);
+ bas0 = SCM_I_ARRAY_BASE (ra0);
}
else
return 0;
@@ -157,10 +157,10 @@ scm_ra_matchp (SCM ra0, SCM ras)
return 0;
}
}
- else if (SCM_ARRAYP (ra1) && ndim == SCM_ARRAY_NDIM (ra1))
+ else if (SCM_I_ARRAYP (ra1) && ndim == SCM_I_ARRAY_NDIM (ra1))
{
- s1 = SCM_ARRAY_DIMS (ra1);
- if (bas0 != SCM_ARRAY_BASE (ra1))
+ s1 = SCM_I_ARRAY_DIMS (ra1);
+ if (bas0 != SCM_I_ARRAY_BASE (ra1))
exact = 3;
for (i = 0; i < ndim; i++)
switch (exact)
@@ -211,20 +211,20 @@ scm_ramapc (int (*cproc)(), SCM data, SCM ra0, SCM lra, const char *what)
case 2:
case 3:
case 4: /* Try unrolling arrays */
- kmax = (SCM_ARRAYP (ra0) ? SCM_ARRAY_NDIM (ra0) - 1 : 0);
+ kmax = (SCM_I_ARRAYP (ra0) ? SCM_I_ARRAY_NDIM (ra0) - 1 : 0);
if (kmax < 0)
goto gencase;
vra0 = scm_array_contents (ra0, SCM_UNDEFINED);
if (SCM_IMP (vra0)) goto gencase;
- if (!SCM_ARRAYP (vra0))
+ if (!SCM_I_ARRAYP (vra0))
{
size_t length = scm_c_generalized_vector_length (vra0);
vra1 = scm_i_make_ra (1, 0);
- SCM_ARRAY_BASE (vra1) = 0;
- SCM_ARRAY_DIMS (vra1)->lbnd = 0;
- SCM_ARRAY_DIMS (vra1)->ubnd = length - 1;
- SCM_ARRAY_DIMS (vra1)->inc = 1;
- SCM_ARRAY_V (vra1) = vra0;
+ SCM_I_ARRAY_BASE (vra1) = 0;
+ SCM_I_ARRAY_DIMS (vra1)->lbnd = 0;
+ SCM_I_ARRAY_DIMS (vra1)->ubnd = length - 1;
+ SCM_I_ARRAY_DIMS (vra1)->inc = 1;
+ SCM_I_ARRAY_V (vra1) = vra0;
vra0 = vra1;
}
lvra = SCM_EOL;
@@ -233,21 +233,21 @@ scm_ramapc (int (*cproc)(), SCM data, SCM ra0, SCM lra, const char *what)
{
ra1 = SCM_CAR (z);
vra1 = scm_i_make_ra (1, 0);
- SCM_ARRAY_DIMS (vra1)->lbnd = SCM_ARRAY_DIMS (vra0)->lbnd;
- SCM_ARRAY_DIMS (vra1)->ubnd = SCM_ARRAY_DIMS (vra0)->ubnd;
- if (!SCM_ARRAYP (ra1))
+ SCM_I_ARRAY_DIMS (vra1)->lbnd = SCM_I_ARRAY_DIMS (vra0)->lbnd;
+ SCM_I_ARRAY_DIMS (vra1)->ubnd = SCM_I_ARRAY_DIMS (vra0)->ubnd;
+ if (!SCM_I_ARRAYP (ra1))
{
- SCM_ARRAY_BASE (vra1) = 0;
- SCM_ARRAY_DIMS (vra1)->inc = 1;
- SCM_ARRAY_V (vra1) = ra1;
+ SCM_I_ARRAY_BASE (vra1) = 0;
+ SCM_I_ARRAY_DIMS (vra1)->inc = 1;
+ SCM_I_ARRAY_V (vra1) = ra1;
}
- else if (!SCM_ARRAY_CONTP (ra1))
+ else if (!SCM_I_ARRAY_CONTP (ra1))
goto gencase;
else
{
- SCM_ARRAY_BASE (vra1) = SCM_ARRAY_BASE (ra1);
- SCM_ARRAY_DIMS (vra1)->inc = SCM_ARRAY_DIMS (ra1)[kmax].inc;
- SCM_ARRAY_V (vra1) = SCM_ARRAY_V (ra1);
+ SCM_I_ARRAY_BASE (vra1) = SCM_I_ARRAY_BASE (ra1);
+ SCM_I_ARRAY_DIMS (vra1)->inc = SCM_I_ARRAY_DIMS (ra1)[kmax].inc;
+ SCM_I_ARRAY_V (vra1) = SCM_I_ARRAY_V (ra1);
}
*plvra = scm_cons (vra1, SCM_EOL);
plvra = SCM_CDRLOC (*plvra);
@@ -256,33 +256,33 @@ scm_ramapc (int (*cproc)(), SCM data, SCM ra0, SCM lra, const char *what)
case 1:
gencase: /* Have to loop over all dimensions. */
vra0 = scm_i_make_ra (1, 0);
- if (SCM_ARRAYP (ra0))
+ if (SCM_I_ARRAYP (ra0))
{
- kmax = SCM_ARRAY_NDIM (ra0) - 1;
+ kmax = SCM_I_ARRAY_NDIM (ra0) - 1;
if (kmax < 0)
{
- SCM_ARRAY_DIMS (vra0)->lbnd = 0;
- SCM_ARRAY_DIMS (vra0)->ubnd = 0;
- SCM_ARRAY_DIMS (vra0)->inc = 1;
+ SCM_I_ARRAY_DIMS (vra0)->lbnd = 0;
+ SCM_I_ARRAY_DIMS (vra0)->ubnd = 0;
+ SCM_I_ARRAY_DIMS (vra0)->inc = 1;
}
else
{
- SCM_ARRAY_DIMS (vra0)->lbnd = SCM_ARRAY_DIMS (ra0)[kmax].lbnd;
- SCM_ARRAY_DIMS (vra0)->ubnd = SCM_ARRAY_DIMS (ra0)[kmax].ubnd;
- SCM_ARRAY_DIMS (vra0)->inc = SCM_ARRAY_DIMS (ra0)[kmax].inc;
+ SCM_I_ARRAY_DIMS (vra0)->lbnd = SCM_I_ARRAY_DIMS (ra0)[kmax].lbnd;
+ SCM_I_ARRAY_DIMS (vra0)->ubnd = SCM_I_ARRAY_DIMS (ra0)[kmax].ubnd;
+ SCM_I_ARRAY_DIMS (vra0)->inc = SCM_I_ARRAY_DIMS (ra0)[kmax].inc;
}
- SCM_ARRAY_BASE (vra0) = SCM_ARRAY_BASE (ra0);
- SCM_ARRAY_V (vra0) = SCM_ARRAY_V (ra0);
+ SCM_I_ARRAY_BASE (vra0) = SCM_I_ARRAY_BASE (ra0);
+ SCM_I_ARRAY_V (vra0) = SCM_I_ARRAY_V (ra0);
}
else
{
size_t length = scm_c_generalized_vector_length (ra0);
kmax = 0;
- SCM_ARRAY_DIMS (vra0)->lbnd = 0;
- SCM_ARRAY_DIMS (vra0)->ubnd = length - 1;
- SCM_ARRAY_DIMS (vra0)->inc = 1;
- SCM_ARRAY_BASE (vra0) = 0;
- SCM_ARRAY_V (vra0) = ra0;
+ SCM_I_ARRAY_DIMS (vra0)->lbnd = 0;
+ SCM_I_ARRAY_DIMS (vra0)->ubnd = length - 1;
+ SCM_I_ARRAY_DIMS (vra0)->inc = 1;
+ SCM_I_ARRAY_BASE (vra0) = 0;
+ SCM_I_ARRAY_V (vra0) = ra0;
ra0 = vra0;
}
lvra = SCM_EOL;
@@ -291,18 +291,18 @@ scm_ramapc (int (*cproc)(), SCM data, SCM ra0, SCM lra, const char *what)
{
ra1 = SCM_CAR (z);
vra1 = scm_i_make_ra (1, 0);
- SCM_ARRAY_DIMS (vra1)->lbnd = SCM_ARRAY_DIMS (vra0)->lbnd;
- SCM_ARRAY_DIMS (vra1)->ubnd = SCM_ARRAY_DIMS (vra0)->ubnd;
- if (SCM_ARRAYP (ra1))
+ SCM_I_ARRAY_DIMS (vra1)->lbnd = SCM_I_ARRAY_DIMS (vra0)->lbnd;
+ SCM_I_ARRAY_DIMS (vra1)->ubnd = SCM_I_ARRAY_DIMS (vra0)->ubnd;
+ if (SCM_I_ARRAYP (ra1))
{
if (kmax >= 0)
- SCM_ARRAY_DIMS (vra1)->inc = SCM_ARRAY_DIMS (ra1)[kmax].inc;
- SCM_ARRAY_V (vra1) = SCM_ARRAY_V (ra1);
+ SCM_I_ARRAY_DIMS (vra1)->inc = SCM_I_ARRAY_DIMS (ra1)[kmax].inc;
+ SCM_I_ARRAY_V (vra1) = SCM_I_ARRAY_V (ra1);
}
else
{
- SCM_ARRAY_DIMS (vra1)->inc = 1;
- SCM_ARRAY_V (vra1) = ra1;
+ SCM_I_ARRAY_DIMS (vra1)->inc = 1;
+ SCM_I_ARRAY_V (vra1) = ra1;
}
*plvra = scm_cons (vra1, SCM_EOL);
plvra = SCM_CDRLOC (*plvra);
@@ -310,32 +310,32 @@ scm_ramapc (int (*cproc)(), SCM data, SCM ra0, SCM lra, const char *what)
scm_frame_begin (0);
- vinds = scm_malloc (sizeof(long) * SCM_ARRAY_NDIM (ra0));
+ vinds = scm_malloc (sizeof(long) * SCM_I_ARRAY_NDIM (ra0));
scm_frame_free (vinds);
for (k = 0; k <= kmax; k++)
- vinds[k] = SCM_ARRAY_DIMS (ra0)[k].lbnd;
+ vinds[k] = SCM_I_ARRAY_DIMS (ra0)[k].lbnd;
k = kmax;
do
{
if (k == kmax)
{
SCM y = lra;
- SCM_ARRAY_BASE (vra0) = cind (ra0, vinds);
+ SCM_I_ARRAY_BASE (vra0) = cind (ra0, vinds);
for (z = lvra; SCM_NIMP (z); z = SCM_CDR (z), y = SCM_CDR (y))
- SCM_ARRAY_BASE (SCM_CAR (z)) = cind (SCM_CAR (y), vinds);
+ SCM_I_ARRAY_BASE (SCM_CAR (z)) = cind (SCM_CAR (y), vinds);
if (0 == (SCM_UNBNDP (data) ? cproc(vra0, lvra) : cproc(vra0, data, lvra)))
return 0;
k--;
continue;
}
- if (vinds[k] < SCM_ARRAY_DIMS (ra0)[k].ubnd)
+ if (vinds[k] < SCM_I_ARRAY_DIMS (ra0)[k].ubnd)
{
vinds[k]++;
k++;
continue;
}
- vinds[k] = SCM_ARRAY_DIMS (ra0)[k].lbnd - 1;
+ vinds[k] = SCM_I_ARRAY_DIMS (ra0)[k].lbnd - 1;
k--;
}
while (k >= 0);
@@ -364,11 +364,11 @@ scm_array_fill_int (SCM ra, SCM fill, SCM ignore SCM_UNUSED)
#define FUNC_NAME s_scm_array_fill_x
{
unsigned long i;
- unsigned long n = SCM_ARRAY_DIMS (ra)->ubnd - SCM_ARRAY_DIMS (ra)->lbnd + 1;
- long inc = SCM_ARRAY_DIMS (ra)->inc;
- unsigned long base = SCM_ARRAY_BASE (ra);
+ unsigned long n = SCM_I_ARRAY_DIMS (ra)->ubnd - SCM_I_ARRAY_DIMS (ra)->lbnd + 1;
+ long inc = SCM_I_ARRAY_DIMS (ra)->inc;
+ unsigned long base = SCM_I_ARRAY_BASE (ra);
- ra = SCM_ARRAY_V (ra);
+ ra = SCM_I_ARRAY_V (ra);
for (i = base; n--; i += inc)
GVSET (ra, i, fill);
@@ -382,14 +382,14 @@ scm_array_fill_int (SCM ra, SCM fill, SCM ignore SCM_UNUSED)
static int
racp (SCM src, SCM dst)
{
- long n = (SCM_ARRAY_DIMS (src)->ubnd - SCM_ARRAY_DIMS (src)->lbnd + 1);
- long inc_d, inc_s = SCM_ARRAY_DIMS (src)->inc;
- unsigned long i_d, i_s = SCM_ARRAY_BASE (src);
+ long n = (SCM_I_ARRAY_DIMS (src)->ubnd - SCM_I_ARRAY_DIMS (src)->lbnd + 1);
+ long inc_d, inc_s = SCM_I_ARRAY_DIMS (src)->inc;
+ unsigned long i_d, i_s = SCM_I_ARRAY_BASE (src);
dst = SCM_CAR (dst);
- inc_d = SCM_ARRAY_DIMS (dst)->inc;
- i_d = SCM_ARRAY_BASE (dst);
- src = SCM_ARRAY_V (src);
- dst = SCM_ARRAY_V (dst);
+ inc_d = SCM_I_ARRAY_DIMS (dst)->inc;
+ i_d = SCM_I_ARRAY_BASE (dst);
+ src = SCM_I_ARRAY_V (src);
+ dst = SCM_I_ARRAY_V (dst);
for (; n-- > 0; i_s += inc_s, i_d += inc_d)
GVSET (dst, i_d, GVREF (src, i_s));
@@ -420,14 +420,14 @@ int
scm_ra_eqp (SCM ra0, SCM ras)
{
SCM ra1 = SCM_CAR (ras), ra2 = SCM_CAR (SCM_CDR (ras));
- long n = SCM_ARRAY_DIMS (ra0)->ubnd - SCM_ARRAY_DIMS (ra0)->lbnd + 1;
- unsigned long i0 = SCM_ARRAY_BASE (ra0), i1 = SCM_ARRAY_BASE (ra1), i2 = SCM_ARRAY_BASE (ra2);
- long inc0 = SCM_ARRAY_DIMS (ra0)->inc;
- long inc1 = SCM_ARRAY_DIMS (ra1)->inc;
- long inc2 = SCM_ARRAY_DIMS (ra1)->inc;
- ra0 = SCM_ARRAY_V (ra0);
- ra1 = SCM_ARRAY_V (ra1);
- ra2 = SCM_ARRAY_V (ra2);
+ long n = SCM_I_ARRAY_DIMS (ra0)->ubnd - SCM_I_ARRAY_DIMS (ra0)->lbnd + 1;
+ unsigned long i0 = SCM_I_ARRAY_BASE (ra0), i1 = SCM_I_ARRAY_BASE (ra1), i2 = SCM_I_ARRAY_BASE (ra2);
+ long inc0 = SCM_I_ARRAY_DIMS (ra0)->inc;
+ long inc1 = SCM_I_ARRAY_DIMS (ra1)->inc;
+ long inc2 = SCM_I_ARRAY_DIMS (ra1)->inc;
+ ra0 = SCM_I_ARRAY_V (ra0);
+ ra1 = SCM_I_ARRAY_V (ra1);
+ ra2 = SCM_I_ARRAY_V (ra2);
{
for (; n-- > 0; i0 += inc0, i1 += inc1, i2 += inc2)
@@ -444,14 +444,14 @@ scm_ra_eqp (SCM ra0, SCM ras)
static int
ra_compare (SCM ra0, SCM ra1, SCM ra2, int opt)
{
- long n = SCM_ARRAY_DIMS (ra0)->ubnd - SCM_ARRAY_DIMS (ra0)->lbnd + 1;
- unsigned long i0 = SCM_ARRAY_BASE (ra0), i1 = SCM_ARRAY_BASE (ra1), i2 = SCM_ARRAY_BASE (ra2);
- long inc0 = SCM_ARRAY_DIMS (ra0)->inc;
- long inc1 = SCM_ARRAY_DIMS (ra1)->inc;
- long inc2 = SCM_ARRAY_DIMS (ra1)->inc;
- ra0 = SCM_ARRAY_V (ra0);
- ra1 = SCM_ARRAY_V (ra1);
- ra2 = SCM_ARRAY_V (ra2);
+ long n = SCM_I_ARRAY_DIMS (ra0)->ubnd - SCM_I_ARRAY_DIMS (ra0)->lbnd + 1;
+ unsigned long i0 = SCM_I_ARRAY_BASE (ra0), i1 = SCM_I_ARRAY_BASE (ra1), i2 = SCM_I_ARRAY_BASE (ra2);
+ long inc0 = SCM_I_ARRAY_DIMS (ra0)->inc;
+ long inc1 = SCM_I_ARRAY_DIMS (ra1)->inc;
+ long inc2 = SCM_I_ARRAY_DIMS (ra1)->inc;
+ ra0 = SCM_I_ARRAY_V (ra0);
+ ra1 = SCM_I_ARRAY_V (ra1);
+ ra2 = SCM_I_ARRAY_V (ra2);
{
for (; n-- > 0; i0 += inc0, i1 += inc1, i2 += inc2)
@@ -498,16 +498,16 @@ scm_ra_greqp (SCM ra0, SCM ras)
int
scm_ra_sum (SCM ra0, SCM ras)
{
- long n = SCM_ARRAY_DIMS (ra0)->ubnd - SCM_ARRAY_DIMS (ra0)->lbnd + 1;
- unsigned long i0 = SCM_ARRAY_BASE (ra0);
- long inc0 = SCM_ARRAY_DIMS (ra0)->inc;
- ra0 = SCM_ARRAY_V (ra0);
+ long n = SCM_I_ARRAY_DIMS (ra0)->ubnd - SCM_I_ARRAY_DIMS (ra0)->lbnd + 1;
+ unsigned long i0 = SCM_I_ARRAY_BASE (ra0);
+ long inc0 = SCM_I_ARRAY_DIMS (ra0)->inc;
+ ra0 = SCM_I_ARRAY_V (ra0);
if (!scm_is_null(ras))
{
SCM ra1 = SCM_CAR (ras);
- unsigned long i1 = SCM_ARRAY_BASE (ra1);
- long inc1 = SCM_ARRAY_DIMS (ra1)->inc;
- ra1 = SCM_ARRAY_V (ra1);
+ unsigned long i1 = SCM_I_ARRAY_BASE (ra1);
+ long inc1 = SCM_I_ARRAY_DIMS (ra1)->inc;
+ ra1 = SCM_I_ARRAY_V (ra1);
switch (SCM_TYP7 (ra0) == SCM_TYP7 (ra1) ? SCM_TYP7 (ra0) : 0)
{
default:
@@ -526,10 +526,10 @@ scm_ra_sum (SCM ra0, SCM ras)
int
scm_ra_difference (SCM ra0, SCM ras)
{
- long n = SCM_ARRAY_DIMS (ra0)->ubnd - SCM_ARRAY_DIMS (ra0)->lbnd + 1;
- unsigned long i0 = SCM_ARRAY_BASE (ra0);
- long inc0 = SCM_ARRAY_DIMS (ra0)->inc;
- ra0 = SCM_ARRAY_V (ra0);
+ long n = SCM_I_ARRAY_DIMS (ra0)->ubnd - SCM_I_ARRAY_DIMS (ra0)->lbnd + 1;
+ unsigned long i0 = SCM_I_ARRAY_BASE (ra0);
+ long inc0 = SCM_I_ARRAY_DIMS (ra0)->inc;
+ ra0 = SCM_I_ARRAY_V (ra0);
if (scm_is_null (ras))
{
switch (SCM_TYP7 (ra0))
@@ -545,9 +545,9 @@ scm_ra_difference (SCM ra0, SCM ras)
else
{
SCM ra1 = SCM_CAR (ras);
- unsigned long i1 = SCM_ARRAY_BASE (ra1);
- long inc1 = SCM_ARRAY_DIMS (ra1)->inc;
- ra1 = SCM_ARRAY_V (ra1);
+ unsigned long i1 = SCM_I_ARRAY_BASE (ra1);
+ long inc1 = SCM_I_ARRAY_DIMS (ra1)->inc;
+ ra1 = SCM_I_ARRAY_V (ra1);
switch (SCM_TYP7 (ra0) == SCM_TYP7 (ra1) ? SCM_TYP7 (ra0) : 0)
{
default:
@@ -567,16 +567,16 @@ scm_ra_difference (SCM ra0, SCM ras)
int
scm_ra_product (SCM ra0, SCM ras)
{
- long n = SCM_ARRAY_DIMS (ra0)->ubnd - SCM_ARRAY_DIMS (ra0)->lbnd + 1;
- unsigned long i0 = SCM_ARRAY_BASE (ra0);
- long inc0 = SCM_ARRAY_DIMS (ra0)->inc;
- ra0 = SCM_ARRAY_V (ra0);
+ long n = SCM_I_ARRAY_DIMS (ra0)->ubnd - SCM_I_ARRAY_DIMS (ra0)->lbnd + 1;
+ unsigned long i0 = SCM_I_ARRAY_BASE (ra0);
+ long inc0 = SCM_I_ARRAY_DIMS (ra0)->inc;
+ ra0 = SCM_I_ARRAY_V (ra0);
if (!scm_is_null (ras))
{
SCM ra1 = SCM_CAR (ras);
- unsigned long i1 = SCM_ARRAY_BASE (ra1);
- long inc1 = SCM_ARRAY_DIMS (ra1)->inc;
- ra1 = SCM_ARRAY_V (ra1);
+ unsigned long i1 = SCM_I_ARRAY_BASE (ra1);
+ long inc1 = SCM_I_ARRAY_DIMS (ra1)->inc;
+ ra1 = SCM_I_ARRAY_V (ra1);
switch (SCM_TYP7 (ra0) == SCM_TYP7 (ra1) ? SCM_TYP7 (ra0) : 0)
{
default:
@@ -594,10 +594,10 @@ scm_ra_product (SCM ra0, SCM ras)
int
scm_ra_divide (SCM ra0, SCM ras)
{
- long n = SCM_ARRAY_DIMS (ra0)->ubnd - SCM_ARRAY_DIMS (ra0)->lbnd + 1;
- unsigned long i0 = SCM_ARRAY_BASE (ra0);
- long inc0 = SCM_ARRAY_DIMS (ra0)->inc;
- ra0 = SCM_ARRAY_V (ra0);
+ long n = SCM_I_ARRAY_DIMS (ra0)->ubnd - SCM_I_ARRAY_DIMS (ra0)->lbnd + 1;
+ unsigned long i0 = SCM_I_ARRAY_BASE (ra0);
+ long inc0 = SCM_I_ARRAY_DIMS (ra0)->inc;
+ ra0 = SCM_I_ARRAY_V (ra0);
if (scm_is_null (ras))
{
switch (SCM_TYP7 (ra0))
@@ -613,9 +613,9 @@ scm_ra_divide (SCM ra0, SCM ras)
else
{
SCM ra1 = SCM_CAR (ras);
- unsigned long i1 = SCM_ARRAY_BASE (ra1);
- long inc1 = SCM_ARRAY_DIMS (ra1)->inc;
- ra1 = SCM_ARRAY_V (ra1);
+ unsigned long i1 = SCM_I_ARRAY_BASE (ra1);
+ long inc1 = SCM_I_ARRAY_DIMS (ra1)->inc;
+ ra1 = SCM_I_ARRAY_V (ra1);
switch (SCM_TYP7 (ra0) == SCM_TYP7 (ra1) ? SCM_TYP7 (ra0) : 0)
{
default:
@@ -645,11 +645,11 @@ scm_array_identity (SCM dst, SCM src)
static int
ramap (SCM ra0, SCM proc, SCM ras)
{
- long i = SCM_ARRAY_DIMS (ra0)->lbnd;
- long inc = SCM_ARRAY_DIMS (ra0)->inc;
- long n = SCM_ARRAY_DIMS (ra0)->ubnd;
- long base = SCM_ARRAY_BASE (ra0) - i * inc;
- ra0 = SCM_ARRAY_V (ra0);
+ long i = SCM_I_ARRAY_DIMS (ra0)->lbnd;
+ long inc = SCM_I_ARRAY_DIMS (ra0)->inc;
+ long n = SCM_I_ARRAY_DIMS (ra0)->ubnd;
+ long base = SCM_I_ARRAY_BASE (ra0) - i * inc;
+ ra0 = SCM_I_ARRAY_V (ra0);
if (scm_is_null (ras))
for (; i <= n; i++)
GVSET (ra0, i*inc+base, scm_call_0 (proc));
@@ -657,9 +657,9 @@ ramap (SCM ra0, SCM proc, SCM ras)
{
SCM ra1 = SCM_CAR (ras);
SCM args;
- unsigned long k, i1 = SCM_ARRAY_BASE (ra1);
- long inc1 = SCM_ARRAY_DIMS (ra1)->inc;
- ra1 = SCM_ARRAY_V (ra1);
+ unsigned long k, i1 = SCM_I_ARRAY_BASE (ra1);
+ long inc1 = SCM_I_ARRAY_DIMS (ra1)->inc;
+ ra1 = SCM_I_ARRAY_V (ra1);
ras = SCM_CDR (ras);
if (scm_is_null(ras))
ras = scm_nullvect;
@@ -683,11 +683,11 @@ static int
ramap_dsubr (SCM ra0, SCM proc, SCM ras)
{
SCM ra1 = SCM_CAR (ras);
- unsigned long i0 = SCM_ARRAY_BASE (ra0), i1 = SCM_ARRAY_BASE (ra1);
- long inc0 = SCM_ARRAY_DIMS (ra0)->inc, inc1 = SCM_ARRAY_DIMS (ra1)->inc;
- long n = SCM_ARRAY_DIMS (ra0)->ubnd - SCM_ARRAY_DIMS (ra1)->lbnd + 1;
- ra0 = SCM_ARRAY_V (ra0);
- ra1 = SCM_ARRAY_V (ra1);
+ unsigned long i0 = SCM_I_ARRAY_BASE (ra0), i1 = SCM_I_ARRAY_BASE (ra1);
+ long inc0 = SCM_I_ARRAY_DIMS (ra0)->inc, inc1 = SCM_I_ARRAY_DIMS (ra1)->inc;
+ long n = SCM_I_ARRAY_DIMS (ra0)->ubnd - SCM_I_ARRAY_DIMS (ra1)->lbnd + 1;
+ ra0 = SCM_I_ARRAY_V (ra0);
+ ra1 = SCM_I_ARRAY_V (ra1);
switch (SCM_TYP7 (ra0))
{
default:
@@ -704,14 +704,14 @@ static int
ramap_rp (SCM ra0, SCM proc, SCM ras)
{
SCM ra1 = SCM_CAR (ras), ra2 = SCM_CAR (SCM_CDR (ras));
- long n = SCM_ARRAY_DIMS (ra0)->ubnd - SCM_ARRAY_DIMS (ra0)->lbnd + 1;
- unsigned long i0 = SCM_ARRAY_BASE (ra0), i1 = SCM_ARRAY_BASE (ra1), i2 = SCM_ARRAY_BASE (ra2);
- long inc0 = SCM_ARRAY_DIMS (ra0)->inc;
- long inc1 = SCM_ARRAY_DIMS (ra1)->inc;
- long inc2 = SCM_ARRAY_DIMS (ra1)->inc;
- ra0 = SCM_ARRAY_V (ra0);
- ra1 = SCM_ARRAY_V (ra1);
- ra2 = SCM_ARRAY_V (ra2);
+ long n = SCM_I_ARRAY_DIMS (ra0)->ubnd - SCM_I_ARRAY_DIMS (ra0)->lbnd + 1;
+ unsigned long i0 = SCM_I_ARRAY_BASE (ra0), i1 = SCM_I_ARRAY_BASE (ra1), i2 = SCM_I_ARRAY_BASE (ra2);
+ long inc0 = SCM_I_ARRAY_DIMS (ra0)->inc;
+ long inc1 = SCM_I_ARRAY_DIMS (ra1)->inc;
+ long inc2 = SCM_I_ARRAY_DIMS (ra1)->inc;
+ ra0 = SCM_I_ARRAY_V (ra0);
+ ra1 = SCM_I_ARRAY_V (ra1);
+ ra2 = SCM_I_ARRAY_V (ra2);
for (; n-- > 0; i0 += inc0, i1 += inc1, i2 += inc2)
if (scm_is_true (scm_c_bitvector_ref (ra0, i0)))
@@ -727,11 +727,11 @@ static int
ramap_1 (SCM ra0, SCM proc, SCM ras)
{
SCM ra1 = SCM_CAR (ras);
- long n = SCM_ARRAY_DIMS (ra0)->ubnd - SCM_ARRAY_DIMS (ra0)->lbnd + 1;
- unsigned long i0 = SCM_ARRAY_BASE (ra0), i1 = SCM_ARRAY_BASE (ra1);
- long inc0 = SCM_ARRAY_DIMS (ra0)->inc, inc1 = SCM_ARRAY_DIMS (ra1)->inc;
- ra0 = SCM_ARRAY_V (ra0);
- ra1 = SCM_ARRAY_V (ra1);
+ long n = SCM_I_ARRAY_DIMS (ra0)->ubnd - SCM_I_ARRAY_DIMS (ra0)->lbnd + 1;
+ unsigned long i0 = SCM_I_ARRAY_BASE (ra0), i1 = SCM_I_ARRAY_BASE (ra1);
+ long inc0 = SCM_I_ARRAY_DIMS (ra0)->inc, inc1 = SCM_I_ARRAY_DIMS (ra1)->inc;
+ ra0 = SCM_I_ARRAY_V (ra0);
+ ra1 = SCM_I_ARRAY_V (ra1);
if (scm_tc7_vector == SCM_TYP7 (ra0) || scm_tc7_wvect == SCM_TYP7 (ra0))
for (; n-- > 0; i0 += inc0, i1 += inc1)
GVSET (ra0, i0, SCM_SUBRF (proc) (GVREF (ra1, i1)));
@@ -747,11 +747,11 @@ static int
ramap_2o (SCM ra0, SCM proc, SCM ras)
{
SCM ra1 = SCM_CAR (ras);
- long n = SCM_ARRAY_DIMS (ra0)->ubnd - SCM_ARRAY_DIMS (ra0)->lbnd + 1;
- unsigned long i0 = SCM_ARRAY_BASE (ra0), i1 = SCM_ARRAY_BASE (ra1);
- long inc0 = SCM_ARRAY_DIMS (ra0)->inc, inc1 = SCM_ARRAY_DIMS (ra1)->inc;
- ra0 = SCM_ARRAY_V (ra0);
- ra1 = SCM_ARRAY_V (ra1);
+ long n = SCM_I_ARRAY_DIMS (ra0)->ubnd - SCM_I_ARRAY_DIMS (ra0)->lbnd + 1;
+ unsigned long i0 = SCM_I_ARRAY_BASE (ra0), i1 = SCM_I_ARRAY_BASE (ra1);
+ long inc0 = SCM_I_ARRAY_DIMS (ra0)->inc, inc1 = SCM_I_ARRAY_DIMS (ra1)->inc;
+ ra0 = SCM_I_ARRAY_V (ra0);
+ ra1 = SCM_I_ARRAY_V (ra1);
ras = SCM_CDR (ras);
if (scm_is_null (ras))
{
@@ -761,9 +761,9 @@ ramap_2o (SCM ra0, SCM proc, SCM ras)
else
{
SCM ra2 = SCM_CAR (ras);
- unsigned long i2 = SCM_ARRAY_BASE (ra2);
- long inc2 = SCM_ARRAY_DIMS (ra2)->inc;
- ra2 = SCM_ARRAY_V (ra2);
+ unsigned long i2 = SCM_I_ARRAY_BASE (ra2);
+ long inc2 = SCM_I_ARRAY_DIMS (ra2)->inc;
+ ra2 = SCM_I_ARRAY_V (ra2);
for (; n-- > 0; i0 += inc0, i1 += inc1, i2 += inc2)
GVSET (ra0, i0, SCM_SUBRF (proc) (GVREF (ra1, i1), GVREF (ra2, i2)));
}
@@ -775,19 +775,19 @@ ramap_2o (SCM ra0, SCM proc, SCM ras)
static int
ramap_a (SCM ra0, SCM proc, SCM ras)
{
- long n = SCM_ARRAY_DIMS (ra0)->ubnd - SCM_ARRAY_DIMS (ra0)->lbnd + 1;
- unsigned long i0 = SCM_ARRAY_BASE (ra0);
- long inc0 = SCM_ARRAY_DIMS (ra0)->inc;
- ra0 = SCM_ARRAY_V (ra0);
+ long n = SCM_I_ARRAY_DIMS (ra0)->ubnd - SCM_I_ARRAY_DIMS (ra0)->lbnd + 1;
+ unsigned long i0 = SCM_I_ARRAY_BASE (ra0);
+ long inc0 = SCM_I_ARRAY_DIMS (ra0)->inc;
+ ra0 = SCM_I_ARRAY_V (ra0);
if (scm_is_null (ras))
for (; n-- > 0; i0 += inc0)
GVSET (ra0, i0, SCM_SUBRF (proc) (GVREF (ra0, i0), SCM_UNDEFINED));
else
{
SCM ra1 = SCM_CAR (ras);
- unsigned long i1 = SCM_ARRAY_BASE (ra1);
- long inc1 = SCM_ARRAY_DIMS (ra1)->inc;
- ra1 = SCM_ARRAY_V (ra1);
+ unsigned long i1 = SCM_I_ARRAY_BASE (ra1);
+ long inc1 = SCM_I_ARRAY_DIMS (ra1)->inc;
+ ra1 = SCM_I_ARRAY_V (ra1);
for (; n-- > 0; i0 += inc0, i1 += inc1)
GVSET (ra0, i0, SCM_SUBRF (proc) (GVREF (ra0, i0), GVREF (ra1, i1)));
}
@@ -865,21 +865,21 @@ SCM_DEFINE (scm_array_map_x, "array-map!", 2, 0, 1,
else
{
SCM tail, ra1 = SCM_CAR (lra);
- SCM v0 = (SCM_ARRAYP (ra0) ? SCM_ARRAY_V (ra0) : ra0);
+ SCM v0 = (SCM_I_ARRAYP (ra0) ? SCM_I_ARRAY_V (ra0) : ra0);
ra_iproc *p;
/* Check to see if order might matter.
This might be an argument for a separate
SERIAL-ARRAY-MAP! */
if (scm_is_eq (v0, ra1)
- || (SCM_ARRAYP (ra1) && scm_is_eq (v0, SCM_ARRAY_V (ra1))))
+ || (SCM_I_ARRAYP (ra1) && scm_is_eq (v0, SCM_I_ARRAY_V (ra1))))
if (!scm_is_eq (ra0, ra1)
- || (SCM_ARRAYP(ra0) && !SCM_ARRAY_CONTP(ra0)))
+ || (SCM_I_ARRAYP(ra0) && !SCM_I_ARRAY_CONTP(ra0)))
goto gencase;
for (tail = SCM_CDR (lra); !scm_is_null (tail); tail = SCM_CDR (tail))
{
ra1 = SCM_CAR (tail);
if (scm_is_eq (v0, ra1)
- || (SCM_ARRAYP (ra1) && scm_is_eq (v0, SCM_ARRAY_V (ra1))))
+ || (SCM_I_ARRAYP (ra1) && scm_is_eq (v0, SCM_I_ARRAY_V (ra1))))
goto gencase;
}
for (p = ra_asubrs; p->name; p++)
@@ -911,11 +911,11 @@ SCM_DEFINE (scm_array_map_x, "array-map!", 2, 0, 1,
static int
rafe (SCM ra0, SCM proc, SCM ras)
{
- long i = SCM_ARRAY_DIMS (ra0)->lbnd;
- unsigned long i0 = SCM_ARRAY_BASE (ra0);
- long inc0 = SCM_ARRAY_DIMS (ra0)->inc;
- long n = SCM_ARRAY_DIMS (ra0)->ubnd;
- ra0 = SCM_ARRAY_V (ra0);
+ long i = SCM_I_ARRAY_DIMS (ra0)->lbnd;
+ unsigned long i0 = SCM_I_ARRAY_BASE (ra0);
+ long inc0 = SCM_I_ARRAY_DIMS (ra0)->inc;
+ long n = SCM_I_ARRAY_DIMS (ra0)->ubnd;
+ ra0 = SCM_I_ARRAY_V (ra0);
if (scm_is_null (ras))
for (; i <= n; i++, i0 += inc0)
scm_call_1 (proc, GVREF (ra0, i0));
@@ -923,9 +923,9 @@ rafe (SCM ra0, SCM proc, SCM ras)
{
SCM ra1 = SCM_CAR (ras);
SCM args;
- unsigned long k, i1 = SCM_ARRAY_BASE (ra1);
- long inc1 = SCM_ARRAY_DIMS (ra1)->inc;
- ra1 = SCM_ARRAY_V (ra1);
+ unsigned long k, i1 = SCM_I_ARRAY_BASE (ra1);
+ long inc1 = SCM_I_ARRAY_DIMS (ra1)->inc;
+ ra1 = SCM_I_ARRAY_V (ra1);
ras = SCM_CDR (ras);
if (scm_is_null(ras))
ras = scm_nullvect;
@@ -988,10 +988,10 @@ SCM_DEFINE (scm_array_index_map_x, "array-index-map!", 2, 0, 0,
GVSET (ra, i, scm_call_1 (proc, scm_from_ulong (i)));
return SCM_UNSPECIFIED;
}
- else if (SCM_ARRAYP (ra))
+ else if (SCM_I_ARRAYP (ra))
{
SCM args = SCM_EOL;
- int j, k, kmax = SCM_ARRAY_NDIM (ra) - 1;
+ int j, k, kmax = SCM_I_ARRAY_NDIM (ra) - 1;
long *vinds;
if (kmax < 0)
@@ -999,35 +999,35 @@ SCM_DEFINE (scm_array_index_map_x, "array-index-map!", 2, 0, 0,
scm_frame_begin (0);
- vinds = scm_malloc (sizeof(long) * SCM_ARRAY_NDIM (ra));
+ vinds = scm_malloc (sizeof(long) * SCM_I_ARRAY_NDIM (ra));
scm_frame_free (vinds);
for (k = 0; k <= kmax; k++)
- vinds[k] = SCM_ARRAY_DIMS (ra)[k].lbnd;
+ vinds[k] = SCM_I_ARRAY_DIMS (ra)[k].lbnd;
k = kmax;
do
{
if (k == kmax)
{
- vinds[k] = SCM_ARRAY_DIMS (ra)[k].lbnd;
+ vinds[k] = SCM_I_ARRAY_DIMS (ra)[k].lbnd;
i = cind (ra, vinds);
- for (; vinds[k] <= SCM_ARRAY_DIMS (ra)[k].ubnd; vinds[k]++)
+ for (; vinds[k] <= SCM_I_ARRAY_DIMS (ra)[k].ubnd; vinds[k]++)
{
for (j = kmax + 1, args = SCM_EOL; j--;)
args = scm_cons (scm_from_long (vinds[j]), args);
- GVSET (SCM_ARRAY_V (ra), i, scm_apply_0 (proc, args));
- i += SCM_ARRAY_DIMS (ra)[k].inc;
+ GVSET (SCM_I_ARRAY_V (ra), i, scm_apply_0 (proc, args));
+ i += SCM_I_ARRAY_DIMS (ra)[k].inc;
}
k--;
continue;
}
- if (vinds[k] < SCM_ARRAY_DIMS (ra)[k].ubnd)
+ if (vinds[k] < SCM_I_ARRAY_DIMS (ra)[k].ubnd)
{
vinds[k]++;
k++;
continue;
}
- vinds[k] = SCM_ARRAY_DIMS (ra)[k].lbnd - 1;
+ vinds[k] = SCM_I_ARRAY_DIMS (ra)[k].lbnd - 1;
k--;
}
while (k >= 0);
@@ -1048,21 +1048,21 @@ raeql_1 (SCM ra0, SCM as_equal, SCM ra1)
long inc0 = 1, inc1 = 1;
unsigned long n;
ra1 = SCM_CAR (ra1);
- if (SCM_ARRAYP(ra0))
+ if (SCM_I_ARRAYP(ra0))
{
- n = SCM_ARRAY_DIMS (ra0)->ubnd - SCM_ARRAY_DIMS (ra0)->lbnd + 1;
- i0 = SCM_ARRAY_BASE (ra0);
- inc0 = SCM_ARRAY_DIMS (ra0)->inc;
- ra0 = SCM_ARRAY_V (ra0);
+ n = SCM_I_ARRAY_DIMS (ra0)->ubnd - SCM_I_ARRAY_DIMS (ra0)->lbnd + 1;
+ i0 = SCM_I_ARRAY_BASE (ra0);
+ inc0 = SCM_I_ARRAY_DIMS (ra0)->inc;
+ ra0 = SCM_I_ARRAY_V (ra0);
}
else
n = scm_c_generalized_vector_length (ra0);
- if (SCM_ARRAYP (ra1))
+ if (SCM_I_ARRAYP (ra1))
{
- i1 = SCM_ARRAY_BASE (ra1);
- inc1 = SCM_ARRAY_DIMS (ra1)->inc;
- ra1 = SCM_ARRAY_V (ra1);
+ i1 = SCM_I_ARRAY_BASE (ra1);
+ inc1 = SCM_I_ARRAY_DIMS (ra1)->inc;
+ ra1 = SCM_I_ARRAY_V (ra1);
}
if (scm_is_generalized_vector (ra0))
@@ -1093,12 +1093,12 @@ raeql (SCM ra0, SCM as_equal, SCM ra1)
scm_t_array_dim *s0 = &dim0, *s1 = &dim1;
unsigned long bas0 = 0, bas1 = 0;
int k, unroll = 1, vlen = 1, ndim = 1;
- if (SCM_ARRAYP (ra0))
+ if (SCM_I_ARRAYP (ra0))
{
- ndim = SCM_ARRAY_NDIM (ra0);
- s0 = SCM_ARRAY_DIMS (ra0);
- bas0 = SCM_ARRAY_BASE (ra0);
- v0 = SCM_ARRAY_V (ra0);
+ ndim = SCM_I_ARRAY_NDIM (ra0);
+ s0 = SCM_I_ARRAY_DIMS (ra0);
+ bas0 = SCM_I_ARRAY_BASE (ra0);
+ v0 = SCM_I_ARRAY_V (ra0);
}
else
{
@@ -1107,13 +1107,13 @@ raeql (SCM ra0, SCM as_equal, SCM ra1)
s0->ubnd = scm_c_generalized_vector_length (v0) - 1;
unroll = 0;
}
- if (SCM_ARRAYP (ra1))
+ if (SCM_I_ARRAYP (ra1))
{
- if (ndim != SCM_ARRAY_NDIM (ra1))
+ if (ndim != SCM_I_ARRAY_NDIM (ra1))
return 0;
- s1 = SCM_ARRAY_DIMS (ra1);
- bas1 = SCM_ARRAY_BASE (ra1);
- v1 = SCM_ARRAY_V (ra1);
+ s1 = SCM_I_ARRAY_DIMS (ra1);
+ bas1 = SCM_I_ARRAY_BASE (ra1);
+ v1 = SCM_I_ARRAY_V (ra1);
}
else
{
@@ -1173,7 +1173,7 @@ static char s_array_equal_p[] = "array-equal?";
SCM
scm_array_equal_p (SCM ra0, SCM ra1)
{
- if (SCM_ARRAYP (ra0) || SCM_ARRAYP (ra1))
+ if (SCM_I_ARRAYP (ra0) || SCM_I_ARRAYP (ra1))
return scm_from_bool(raeql (ra0, SCM_BOOL_F, ra1));
return scm_equal_p (ra0, ra1);
}
@@ -1201,7 +1201,7 @@ scm_init_ramap ()
init_raprocs (ra_rpsubrs);
init_raprocs (ra_asubrs);
scm_c_define_subr (s_array_equal_p, scm_tc7_rpsubr, scm_array_equal_p);
- scm_smobs[SCM_TC2SMOBNUM (scm_tc16_array)].equalp = scm_raequal;
+ scm_smobs[SCM_TC2SMOBNUM (scm_i_tc16_array)].equalp = scm_raequal;
#include "libguile/ramap.x"
scm_add_feature (s_scm_array_for_each);
}
diff --git a/libguile/srfi-4.c b/libguile/srfi-4.c
index 14f8311bd..2ee65166e 100644
--- a/libguile/srfi-4.c
+++ b/libguile/srfi-4.c
@@ -237,9 +237,9 @@ is_uvec (int type, SCM obj)
{
if (SCM_IS_UVEC (obj))
return SCM_UVEC_TYPE (obj) == type;
- if (SCM_ARRAYP (obj) && SCM_ARRAY_NDIM (obj) == 1)
+ if (SCM_I_ARRAYP (obj) && SCM_I_ARRAY_NDIM (obj) == 1)
{
- SCM v = SCM_ARRAY_V (obj);
+ SCM v = SCM_I_ARRAY_V (obj);
return SCM_IS_UVEC (v) && SCM_UVEC_TYPE (v) == type;
}
return 0;
@@ -374,8 +374,8 @@ uvec_writable_elements (int type, SCM uvec, scm_t_array_handle *handle,
if (type >= 0)
{
SCM v = uvec;
- if (SCM_ARRAYP (v))
- v = SCM_ARRAY_V (v);
+ if (SCM_I_ARRAYP (v))
+ v = SCM_I_ARRAY_V (v);
uvec_assert (type, v);
}
@@ -393,8 +393,8 @@ static int
uvec_type (scm_t_array_handle *h)
{
SCM v = h->array;
- if (SCM_ARRAYP (v))
- v = SCM_ARRAY_V (v);
+ if (SCM_I_ARRAYP (v))
+ v = SCM_I_ARRAY_V (v);
return SCM_UVEC_TYPE (v);
}
@@ -531,9 +531,9 @@ scm_is_uniform_vector (SCM obj)
{
if (SCM_IS_UVEC (obj))
return 1;
- if (SCM_ARRAYP (obj) && SCM_ARRAY_NDIM (obj) == 1)
+ if (SCM_I_ARRAYP (obj) && SCM_I_ARRAY_NDIM (obj) == 1)
{
- SCM v = SCM_ARRAY_V (obj);
+ SCM v = SCM_I_ARRAY_V (obj);
return SCM_IS_UVEC (v);
}
return 0;
@@ -659,8 +659,8 @@ size_t
scm_array_handle_uniform_element_size (scm_t_array_handle *h)
{
SCM vec = h->array;
- if (SCM_ARRAYP (vec))
- vec = SCM_ARRAY_V (vec);
+ if (SCM_I_ARRAYP (vec))
+ vec = SCM_I_ARRAY_V (vec);
if (scm_is_uniform_vector (vec))
return uvec_sizes[SCM_UVEC_TYPE(vec)];
scm_wrong_type_arg_msg (NULL, 0, h->array, "uniform array");
@@ -695,8 +695,8 @@ void *
scm_array_handle_uniform_writable_elements (scm_t_array_handle *h)
{
SCM vec = h->array;
- if (SCM_ARRAYP (vec))
- vec = SCM_ARRAY_V (vec);
+ if (SCM_I_ARRAYP (vec))
+ vec = SCM_I_ARRAY_V (vec);
if (SCM_IS_UVEC (vec))
{
size_t size = uvec_sizes[SCM_UVEC_TYPE(vec)];
diff --git a/libguile/srfi-4.i.c b/libguile/srfi-4.i.c
index 714f4d644..e1c3598c4 100644
--- a/libguile/srfi-4.i.c
+++ b/libguile/srfi-4.i.c
@@ -148,8 +148,8 @@ CTYPE *
F(scm_array_handle_,TAG,_writable_elements) (scm_t_array_handle *h)
{
SCM vec = h->array;
- if (SCM_ARRAYP (vec))
- vec = SCM_ARRAY_V (vec);
+ if (SCM_I_ARRAYP (vec))
+ vec = SCM_I_ARRAY_V (vec);
uvec_assert (TYPE, vec);
if (TYPE == SCM_UVEC_C32 || TYPE == SCM_UVEC_C64)
return ((CTYPE *)SCM_UVEC_BASE (vec)) + 2*h->base;
diff --git a/libguile/unif.c b/libguile/unif.c
index 6ef29b683..0b32c354a 100644
--- a/libguile/unif.c
+++ b/libguile/unif.c
@@ -79,8 +79,13 @@
* long long llvect s64
*/
-scm_t_bits scm_tc16_array;
-scm_t_bits scm_tc16_enclosed_array;
+scm_t_bits scm_i_tc16_array;
+scm_t_bits scm_i_tc16_enclosed_array;
+
+#define SCM_SET_ARRAY_CONTIGUOUS_FLAG(x) \
+ (SCM_SET_CELL_WORD_0 ((x), SCM_CELL_WORD_0 (x) | SCM_I_ARRAY_FLAG_CONTIGUOUS))
+#define SCM_CLR_ARRAY_CONTIGUOUS_FLAG(x) \
+ (SCM_SET_CELL_WORD_0 ((x), SCM_CELL_WORD_0 (x) & ~SCM_I_ARRAY_FLAG_CONTIGUOUS))
typedef SCM creator_proc (SCM len, SCM fill);
@@ -225,15 +230,15 @@ scm_make_uve (long k, SCM prot)
int
scm_is_array (SCM obj)
{
- return (SCM_ENCLOSED_ARRAYP (obj)
- || SCM_ARRAYP (obj)
+ return (SCM_I_ENCLOSED_ARRAYP (obj)
+ || SCM_I_ARRAYP (obj)
|| scm_is_generalized_vector (obj));
}
int
scm_is_typed_array (SCM obj, SCM type)
{
- if (SCM_ENCLOSED_ARRAYP (obj))
+ if (SCM_I_ENCLOSED_ARRAYP (obj))
{
/* Enclosed arrays are arrays but are not of any type.
*/
@@ -242,8 +247,8 @@ scm_is_typed_array (SCM obj, SCM type)
/* Get storage vector.
*/
- if (SCM_ARRAYP (obj))
- obj = SCM_ARRAY_V (obj);
+ if (SCM_I_ARRAYP (obj))
+ obj = SCM_I_ARRAY_V (obj);
/* It must be a generalized vector (which includes vectors, strings, etc).
*/
@@ -256,7 +261,7 @@ scm_is_typed_array (SCM obj, SCM type)
static SCM
enclosed_ref (scm_t_array_handle *h, ssize_t pos)
{
- return scm_i_cvref (SCM_ARRAY_V (h->array), pos + h->base, 1);
+ return scm_i_cvref (SCM_I_ARRAY_V (h->array), pos + h->base, 1);
}
static SCM
@@ -269,8 +274,8 @@ static SCM
string_ref (scm_t_array_handle *h, ssize_t pos)
{
pos += h->base;
- if (SCM_ARRAYP (h->array))
- return scm_c_string_ref (SCM_ARRAY_V (h->array), pos);
+ if (SCM_I_ARRAYP (h->array))
+ return scm_c_string_ref (SCM_I_ARRAY_V (h->array), pos);
else
return scm_c_string_ref (h->array, pos);
}
@@ -288,14 +293,14 @@ memoize_ref (scm_t_array_handle *h, ssize_t pos)
{
SCM v = h->array;
- if (SCM_ENCLOSED_ARRAYP (v))
+ if (SCM_I_ENCLOSED_ARRAYP (v))
{
h->ref = enclosed_ref;
return enclosed_ref (h, pos);
}
- if (SCM_ARRAYP (v))
- v = SCM_ARRAY_V (v);
+ if (SCM_I_ARRAYP (v))
+ v = SCM_I_ARRAY_V (v);
if (scm_is_vector (v))
{
@@ -338,8 +343,8 @@ static void
string_set (scm_t_array_handle *h, ssize_t pos, SCM val)
{
pos += h->base;
- if (SCM_ARRAYP (h->array))
- return scm_c_string_set_x (SCM_ARRAY_V (h->array), pos, val);
+ if (SCM_I_ARRAYP (h->array))
+ return scm_c_string_set_x (SCM_I_ARRAY_V (h->array), pos, val);
else
return scm_c_string_set_x (h->array, pos, val);
}
@@ -361,15 +366,15 @@ memoize_set (scm_t_array_handle *h, ssize_t pos, SCM val)
{
SCM v = h->array;
- if (SCM_ENCLOSED_ARRAYP (v))
+ if (SCM_I_ENCLOSED_ARRAYP (v))
{
h->set = enclosed_set;
enclosed_set (h, pos, val);
return;
}
- if (SCM_ARRAYP (v))
- v = SCM_ARRAY_V (v);
+ if (SCM_I_ARRAYP (v))
+ v = SCM_I_ARRAY_V (v);
if (scm_is_vector (v))
{
@@ -403,10 +408,10 @@ scm_array_get_handle (SCM array, scm_t_array_handle *h)
h->ref = memoize_ref;
h->set = memoize_set;
- if (SCM_ARRAYP (array) || SCM_ENCLOSED_ARRAYP (array))
+ if (SCM_I_ARRAYP (array) || SCM_I_ENCLOSED_ARRAYP (array))
{
- h->dims = SCM_ARRAY_DIMS (array);
- h->base = SCM_ARRAY_BASE (array);
+ h->dims = SCM_I_ARRAY_DIMS (array);
+ h->base = SCM_I_ARRAY_BASE (array);
}
else if (scm_is_generalized_vector (array))
{
@@ -430,8 +435,8 @@ scm_array_handle_release (scm_t_array_handle *h)
size_t
scm_array_handle_rank (scm_t_array_handle *h)
{
- if (SCM_ARRAYP (h->array) || SCM_ENCLOSED_ARRAYP (h->array))
- return SCM_ARRAY_NDIM (h->array);
+ if (SCM_I_ARRAYP (h->array) || SCM_I_ENCLOSED_ARRAYP (h->array))
+ return SCM_I_ARRAY_NDIM (h->array);
else
return 1;
}
@@ -446,8 +451,8 @@ const SCM *
scm_array_handle_elements (scm_t_array_handle *h)
{
SCM vec = h->array;
- if (SCM_ARRAYP (vec))
- vec = SCM_ARRAY_V (vec);
+ if (SCM_I_ARRAYP (vec))
+ vec = SCM_I_ARRAY_V (vec);
if (SCM_I_IS_VECTOR (vec))
return SCM_I_VECTOR_ELTS (vec) + h->base;
scm_wrong_type_arg_msg (NULL, 0, h->array, "non-uniform array");
@@ -457,8 +462,8 @@ SCM *
scm_array_handle_writable_elements (scm_t_array_handle *h)
{
SCM vec = h->array;
- if (SCM_ARRAYP (vec))
- vec = SCM_ARRAY_V (vec);
+ if (SCM_I_ARRAYP (vec))
+ vec = SCM_I_ARRAY_V (vec);
if (SCM_I_IS_VECTOR (vec))
return SCM_I_VECTOR_WELTS (vec) + h->base;
scm_wrong_type_arg_msg (NULL, 0, h->array, "non-uniform array");
@@ -523,20 +528,25 @@ SCM_DEFINE (scm_typed_array_p, "typed-array?", 2, 0, 0,
}
#undef FUNC_NAME
-
-SCM_DEFINE (scm_array_rank, "array-rank", 1, 0, 0,
- (SCM array),
- "Return the number of dimensions of the array @var{array.}\n")
-#define FUNC_NAME s_scm_array_rank
+size_t
+scm_c_array_rank (SCM array)
{
scm_t_array_handle handle;
- SCM res;
+ size_t res;
scm_array_get_handle (array, &handle);
- res = scm_from_size_t (scm_array_handle_rank (&handle));
+ res = scm_array_handle_rank (&handle);
scm_array_handle_release (&handle);
return res;
}
+
+SCM_DEFINE (scm_array_rank, "array-rank", 1, 0, 0,
+ (SCM array),
+ "Return the number of dimensions of the array @var{array.}\n")
+#define FUNC_NAME s_scm_array_rank
+{
+ return scm_from_size_t (scm_c_array_rank (array));
+}
#undef FUNC_NAME
@@ -577,8 +587,8 @@ SCM_DEFINE (scm_shared_array_root, "shared-array-root", 1, 0, 0,
"Return the root vector of a shared array.")
#define FUNC_NAME s_scm_shared_array_root
{
- if (SCM_ARRAYP (ra) || SCM_ENCLOSED_ARRAYP (ra))
- return SCM_ARRAY_V (ra);
+ if (SCM_I_ARRAYP (ra) || SCM_I_ENCLOSED_ARRAYP (ra))
+ return SCM_I_ARRAY_V (ra);
else if (scm_is_generalized_vector (ra))
return ra;
scm_wrong_type_arg_msg (NULL, 0, ra, "array");
@@ -646,13 +656,13 @@ scm_array_handle_pos (scm_t_array_handle *h, SCM indices)
SCM
scm_i_make_ra (int ndim, int enclosed)
{
- scm_t_bits tag = enclosed? scm_tc16_enclosed_array : scm_tc16_array;
+ scm_t_bits tag = enclosed? scm_i_tc16_enclosed_array : scm_i_tc16_array;
SCM ra;
SCM_NEWSMOB(ra, ((scm_t_bits) ndim << 17) + tag,
- scm_gc_malloc ((sizeof (scm_t_array) +
+ scm_gc_malloc ((sizeof (scm_i_t_array) +
ndim * sizeof (scm_t_array_dim)),
"array"));
- SCM_ARRAY_V (ra) = SCM_BOOL_F;
+ SCM_I_ARRAY_V (ra) = SCM_BOOL_F;
return ra;
}
@@ -671,8 +681,8 @@ scm_i_shap2ra (SCM args)
scm_misc_error (NULL, s_bad_spec, SCM_EOL);
ra = scm_i_make_ra (ndim, 0);
- SCM_ARRAY_BASE (ra) = 0;
- s = SCM_ARRAY_DIMS (ra);
+ SCM_I_ARRAY_BASE (ra) = 0;
+ s = SCM_I_ARRAY_DIMS (ra);
for (; !scm_is_null (args); s++, args = SCM_CDR (args))
{
spec = SCM_CAR (args);
@@ -714,8 +724,8 @@ SCM_DEFINE (scm_make_typed_array, "make-typed-array", 2, 0, 1,
creator = type_to_creator (type);
ra = scm_i_shap2ra (bounds);
SCM_SET_ARRAY_CONTIGUOUS_FLAG (ra);
- s = SCM_ARRAY_DIMS (ra);
- k = SCM_ARRAY_NDIM (ra);
+ s = SCM_I_ARRAY_DIMS (ra);
+ k = SCM_I_ARRAY_NDIM (ra);
while (k--)
{
@@ -727,11 +737,11 @@ SCM_DEFINE (scm_make_typed_array, "make-typed-array", 2, 0, 1,
if (scm_is_eq (fill, SCM_UNSPECIFIED))
fill = SCM_UNDEFINED;
- SCM_ARRAY_V (ra) = creator (scm_from_size_t (rlen), fill);
+ SCM_I_ARRAY_V (ra) = creator (scm_from_size_t (rlen), fill);
- if (1 == SCM_ARRAY_NDIM (ra) && 0 == SCM_ARRAY_BASE (ra))
+ if (1 == SCM_I_ARRAY_NDIM (ra) && 0 == SCM_I_ARRAY_BASE (ra))
if (s->ubnd < s->lbnd || (0 == s->lbnd && 1 == s->inc))
- return SCM_ARRAY_V (ra);
+ return SCM_I_ARRAY_V (ra);
return ra;
}
#undef FUNC_NAME
@@ -771,19 +781,19 @@ SCM_DEFINE (scm_dimensions_to_uniform_array, "dimensions->uniform-array", 2, 1,
static void
scm_i_ra_set_contp (SCM ra)
{
- size_t k = SCM_ARRAY_NDIM (ra);
+ size_t k = SCM_I_ARRAY_NDIM (ra);
if (k)
{
- long inc = SCM_ARRAY_DIMS (ra)[k - 1].inc;
+ long inc = SCM_I_ARRAY_DIMS (ra)[k - 1].inc;
while (k--)
{
- if (inc != SCM_ARRAY_DIMS (ra)[k].inc)
+ if (inc != SCM_I_ARRAY_DIMS (ra)[k].inc)
{
SCM_CLR_ARRAY_CONTIGUOUS_FLAG (ra);
return;
}
- inc *= (SCM_ARRAY_DIMS (ra)[k].ubnd
- - SCM_ARRAY_DIMS (ra)[k].lbnd + 1);
+ inc *= (SCM_I_ARRAY_DIMS (ra)[k].ubnd
+ - SCM_I_ARRAY_DIMS (ra)[k].lbnd + 1);
}
}
SCM_SET_ARRAY_CONTIGUOUS_FLAG (ra);
@@ -824,10 +834,10 @@ SCM_DEFINE (scm_make_shared_array, "make-shared-array", 2, 0, 1,
scm_array_get_handle (oldra, &old_handle);
- if (SCM_ARRAYP (oldra))
+ if (SCM_I_ARRAYP (oldra))
{
- SCM_ARRAY_V (ra) = SCM_ARRAY_V (oldra);
- old_min = old_max = SCM_ARRAY_BASE (oldra);
+ SCM_I_ARRAY_V (ra) = SCM_I_ARRAY_V (oldra);
+ old_min = old_max = SCM_I_ARRAY_BASE (oldra);
s = scm_array_handle_dims (&old_handle);
k = scm_array_handle_rank (&old_handle);
while (k--)
@@ -840,22 +850,22 @@ SCM_DEFINE (scm_make_shared_array, "make-shared-array", 2, 0, 1,
}
else
{
- SCM_ARRAY_V (ra) = oldra;
+ SCM_I_ARRAY_V (ra) = oldra;
old_min = 0;
old_max = scm_c_generalized_vector_length (oldra) - 1;
}
inds = SCM_EOL;
- s = SCM_ARRAY_DIMS (ra);
- for (k = 0; k < SCM_ARRAY_NDIM (ra); k++)
+ s = SCM_I_ARRAY_DIMS (ra);
+ for (k = 0; k < SCM_I_ARRAY_NDIM (ra); k++)
{
inds = scm_cons (scm_from_long (s[k].lbnd), inds);
if (s[k].ubnd < s[k].lbnd)
{
- if (1 == SCM_ARRAY_NDIM (ra))
+ if (1 == SCM_I_ARRAY_NDIM (ra))
ra = make_typed_vector (scm_array_type (ra), 0);
else
- SCM_ARRAY_V (ra) = make_typed_vector (scm_array_type (ra), 0);
+ SCM_I_ARRAY_V (ra) = make_typed_vector (scm_array_type (ra), 0);
scm_array_handle_release (&old_handle);
return ra;
}
@@ -863,9 +873,9 @@ SCM_DEFINE (scm_make_shared_array, "make-shared-array", 2, 0, 1,
imap = scm_apply_0 (mapfunc, scm_reverse (inds));
i = scm_array_handle_pos (&old_handle, imap);
- SCM_ARRAY_BASE (ra) = new_min = new_max = i;
+ SCM_I_ARRAY_BASE (ra) = new_min = new_max = i;
indptr = inds;
- k = SCM_ARRAY_NDIM (ra);
+ k = SCM_I_ARRAY_NDIM (ra);
while (k--)
{
if (s[k].ubnd > s[k].lbnd)
@@ -888,9 +898,9 @@ SCM_DEFINE (scm_make_shared_array, "make-shared-array", 2, 0, 1,
if (old_min > new_min || old_max < new_max)
SCM_MISC_ERROR ("mapping out of range", SCM_EOL);
- if (1 == SCM_ARRAY_NDIM (ra) && 0 == SCM_ARRAY_BASE (ra))
+ if (1 == SCM_I_ARRAY_NDIM (ra) && 0 == SCM_I_ARRAY_BASE (ra))
{
- SCM v = SCM_ARRAY_V (ra);
+ SCM v = SCM_I_ARRAY_V (ra);
size_t length = scm_c_generalized_vector_length (v);
if (1 == s->inc && 0 == s->lbnd && length == 1 + s->ubnd)
return v;
@@ -946,33 +956,33 @@ SCM_DEFINE (scm_transpose_array, "transpose-array", 1, 0, 1,
return ra;
}
- if (SCM_ARRAYP (ra) || SCM_ENCLOSED_ARRAYP (ra))
+ if (SCM_I_ARRAYP (ra) || SCM_I_ENCLOSED_ARRAYP (ra))
{
vargs = scm_vector (args);
- if (SCM_SIMPLE_VECTOR_LENGTH (vargs) != SCM_ARRAY_NDIM (ra))
+ if (SCM_SIMPLE_VECTOR_LENGTH (vargs) != SCM_I_ARRAY_NDIM (ra))
SCM_WRONG_NUM_ARGS ();
ndim = 0;
- for (k = 0; k < SCM_ARRAY_NDIM (ra); k++)
+ for (k = 0; k < SCM_I_ARRAY_NDIM (ra); k++)
{
i = scm_to_signed_integer (SCM_SIMPLE_VECTOR_REF (vargs, k),
- 0, SCM_ARRAY_NDIM(ra));
+ 0, SCM_I_ARRAY_NDIM(ra));
if (ndim < i)
ndim = i;
}
ndim++;
res = scm_i_make_ra (ndim, 0);
- SCM_ARRAY_V (res) = SCM_ARRAY_V (ra);
- SCM_ARRAY_BASE (res) = SCM_ARRAY_BASE (ra);
+ SCM_I_ARRAY_V (res) = SCM_I_ARRAY_V (ra);
+ SCM_I_ARRAY_BASE (res) = SCM_I_ARRAY_BASE (ra);
for (k = ndim; k--;)
{
- SCM_ARRAY_DIMS (res)[k].lbnd = 0;
- SCM_ARRAY_DIMS (res)[k].ubnd = -1;
+ SCM_I_ARRAY_DIMS (res)[k].lbnd = 0;
+ SCM_I_ARRAY_DIMS (res)[k].ubnd = -1;
}
- for (k = SCM_ARRAY_NDIM (ra); k--;)
+ for (k = SCM_I_ARRAY_NDIM (ra); k--;)
{
i = scm_to_int (SCM_SIMPLE_VECTOR_REF (vargs, k));
- s = &(SCM_ARRAY_DIMS (ra)[k]);
- r = &(SCM_ARRAY_DIMS (res)[i]);
+ s = &(SCM_I_ARRAY_DIMS (ra)[k]);
+ r = &(SCM_I_ARRAY_DIMS (res)[i]);
if (r->ubnd < r->lbnd)
{
r->lbnd = s->lbnd;
@@ -986,7 +996,7 @@ SCM_DEFINE (scm_transpose_array, "transpose-array", 1, 0, 1,
r->ubnd = s->ubnd;
if (r->lbnd < s->lbnd)
{
- SCM_ARRAY_BASE (res) += (s->lbnd - r->lbnd) * r->inc;
+ SCM_I_ARRAY_BASE (res) += (s->lbnd - r->lbnd) * r->inc;
r->lbnd = s->lbnd;
}
r->inc += s->inc;
@@ -1032,7 +1042,7 @@ SCM_DEFINE (scm_enclose_array, "enclose-array", 1, 0, 1,
SCM_VALIDATE_REST_ARGUMENT (axes);
if (scm_is_null (axes))
- axes = scm_cons ((SCM_ARRAYP (ra) ? scm_from_size_t (SCM_ARRAY_NDIM (ra) - 1) : SCM_INUM0), SCM_EOL);
+ axes = scm_cons ((SCM_I_ARRAYP (ra) ? scm_from_size_t (SCM_I_ARRAY_NDIM (ra) - 1) : SCM_INUM0), SCM_EOL);
ninr = scm_ilength (axes);
if (ninr < 0)
SCM_WRONG_NUM_ARGS ();
@@ -1043,16 +1053,16 @@ SCM_DEFINE (scm_enclose_array, "enclose-array", 1, 0, 1,
s->lbnd = 0;
s->ubnd = scm_c_generalized_vector_length (ra) - 1;
s->inc = 1;
- SCM_ARRAY_V (ra_inr) = ra;
- SCM_ARRAY_BASE (ra_inr) = 0;
+ SCM_I_ARRAY_V (ra_inr) = ra;
+ SCM_I_ARRAY_BASE (ra_inr) = 0;
ndim = 1;
}
- else if (SCM_ARRAYP (ra))
+ else if (SCM_I_ARRAYP (ra))
{
- s = SCM_ARRAY_DIMS (ra);
- SCM_ARRAY_V (ra_inr) = SCM_ARRAY_V (ra);
- SCM_ARRAY_BASE (ra_inr) = SCM_ARRAY_BASE (ra);
- ndim = SCM_ARRAY_NDIM (ra);
+ s = SCM_I_ARRAY_DIMS (ra);
+ SCM_I_ARRAY_V (ra_inr) = SCM_I_ARRAY_V (ra);
+ SCM_I_ARRAY_BASE (ra_inr) = SCM_I_ARRAY_BASE (ra);
+ ndim = SCM_I_ARRAY_NDIM (ra);
}
else
scm_wrong_type_arg_msg (NULL, 0, ra, "array");
@@ -1062,16 +1072,16 @@ SCM_DEFINE (scm_enclose_array, "enclose-array", 1, 0, 1,
SCM_WRONG_NUM_ARGS ();
axv = scm_make_string (scm_from_int (ndim), SCM_MAKE_CHAR (0));
res = scm_i_make_ra (noutr, 1);
- SCM_ARRAY_BASE (res) = SCM_ARRAY_BASE (ra_inr);
- SCM_ARRAY_V (res) = ra_inr;
+ SCM_I_ARRAY_BASE (res) = SCM_I_ARRAY_BASE (ra_inr);
+ SCM_I_ARRAY_V (res) = ra_inr;
for (k = 0; k < ninr; k++, axes = SCM_CDR (axes))
{
if (!scm_is_integer (SCM_CAR (axes)))
SCM_MISC_ERROR ("bad axis", SCM_EOL);
j = scm_to_int (SCM_CAR (axes));
- SCM_ARRAY_DIMS (ra_inr)[k].lbnd = s[j].lbnd;
- SCM_ARRAY_DIMS (ra_inr)[k].ubnd = s[j].ubnd;
- SCM_ARRAY_DIMS (ra_inr)[k].inc = s[j].inc;
+ SCM_I_ARRAY_DIMS (ra_inr)[k].lbnd = s[j].lbnd;
+ SCM_I_ARRAY_DIMS (ra_inr)[k].ubnd = s[j].ubnd;
+ SCM_I_ARRAY_DIMS (ra_inr)[k].inc = s[j].inc;
scm_c_string_set_x (axv, j, SCM_MAKE_CHAR (1));
}
c_axv = scm_i_string_chars (axv);
@@ -1079,9 +1089,9 @@ SCM_DEFINE (scm_enclose_array, "enclose-array", 1, 0, 1,
{
while (c_axv[j])
j++;
- SCM_ARRAY_DIMS (res)[k].lbnd = s[j].lbnd;
- SCM_ARRAY_DIMS (res)[k].ubnd = s[j].ubnd;
- SCM_ARRAY_DIMS (res)[k].inc = s[j].inc;
+ SCM_I_ARRAY_DIMS (res)[k].lbnd = s[j].lbnd;
+ SCM_I_ARRAY_DIMS (res)[k].ubnd = s[j].ubnd;
+ SCM_I_ARRAY_DIMS (res)[k].inc = s[j].inc;
}
scm_remember_upto_here_1 (axv);
scm_i_ra_set_contp (ra_inr);
@@ -1113,10 +1123,10 @@ SCM_DEFINE (scm_array_in_bounds_p, "array-in-bounds?", 1, 0, 1,
res = scm_from_bool (ind >= 0
&& ind < scm_c_generalized_vector_length (v));
}
- else if (SCM_ARRAYP (v) || SCM_ENCLOSED_ARRAYP (v))
+ else if (SCM_I_ARRAYP (v) || SCM_I_ENCLOSED_ARRAYP (v))
{
- size_t k = SCM_ARRAY_NDIM (v);
- scm_t_array_dim *s = SCM_ARRAY_DIMS (v);
+ size_t k = SCM_I_ARRAY_NDIM (v);
+ scm_t_array_dim *s = SCM_I_ARRAY_DIMS (v);
while (k > 0)
{
@@ -1153,15 +1163,15 @@ scm_i_cvref (SCM v, size_t pos, int enclosed)
{
if (enclosed)
{
- int k = SCM_ARRAY_NDIM (v);
+ int k = SCM_I_ARRAY_NDIM (v);
SCM res = scm_i_make_ra (k, 0);
- SCM_ARRAY_V (res) = SCM_ARRAY_V (v);
- SCM_ARRAY_BASE (res) = pos;
+ SCM_I_ARRAY_V (res) = SCM_I_ARRAY_V (v);
+ SCM_I_ARRAY_BASE (res) = pos;
while (k--)
{
- SCM_ARRAY_DIMS (res)[k].ubnd = SCM_ARRAY_DIMS (v)[k].ubnd;
- SCM_ARRAY_DIMS (res)[k].lbnd = SCM_ARRAY_DIMS (v)[k].lbnd;
- SCM_ARRAY_DIMS (res)[k].inc = SCM_ARRAY_DIMS (v)[k].inc;
+ SCM_I_ARRAY_DIMS (res)[k].ubnd = SCM_I_ARRAY_DIMS (v)[k].ubnd;
+ SCM_I_ARRAY_DIMS (res)[k].lbnd = SCM_I_ARRAY_DIMS (v)[k].lbnd;
+ SCM_I_ARRAY_DIMS (res)[k].inc = SCM_I_ARRAY_DIMS (v)[k].inc;
}
return res;
}
@@ -1223,42 +1233,42 @@ SCM_DEFINE (scm_array_contents, "array-contents", 1, 1, 0,
if (scm_is_generalized_vector (ra))
return ra;
- if (SCM_ARRAYP (ra))
+ if (SCM_I_ARRAYP (ra))
{
- size_t k, ndim = SCM_ARRAY_NDIM (ra), len = 1;
- if (!SCM_ARRAYP (ra) || !SCM_ARRAY_CONTP (ra))
+ size_t k, ndim = SCM_I_ARRAY_NDIM (ra), len = 1;
+ if (!SCM_I_ARRAYP (ra) || !SCM_I_ARRAY_CONTP (ra))
return SCM_BOOL_F;
for (k = 0; k < ndim; k++)
- len *= SCM_ARRAY_DIMS (ra)[k].ubnd - SCM_ARRAY_DIMS (ra)[k].lbnd + 1;
+ len *= SCM_I_ARRAY_DIMS (ra)[k].ubnd - SCM_I_ARRAY_DIMS (ra)[k].lbnd + 1;
if (!SCM_UNBNDP (strict))
{
- if (ndim && (1 != SCM_ARRAY_DIMS (ra)[ndim - 1].inc))
+ if (ndim && (1 != SCM_I_ARRAY_DIMS (ra)[ndim - 1].inc))
return SCM_BOOL_F;
- if (scm_is_bitvector (SCM_ARRAY_V (ra)))
+ if (scm_is_bitvector (SCM_I_ARRAY_V (ra)))
{
- if (len != scm_c_bitvector_length (SCM_ARRAY_V (ra)) ||
- SCM_ARRAY_BASE (ra) % SCM_LONG_BIT ||
+ if (len != scm_c_bitvector_length (SCM_I_ARRAY_V (ra)) ||
+ SCM_I_ARRAY_BASE (ra) % SCM_LONG_BIT ||
len % SCM_LONG_BIT)
return SCM_BOOL_F;
}
}
{
- SCM v = SCM_ARRAY_V (ra);
+ SCM v = SCM_I_ARRAY_V (ra);
size_t length = scm_c_generalized_vector_length (v);
- if ((len == length) && 0 == SCM_ARRAY_BASE (ra) && SCM_ARRAY_DIMS (ra)->inc)
+ if ((len == length) && 0 == SCM_I_ARRAY_BASE (ra) && SCM_I_ARRAY_DIMS (ra)->inc)
return v;
}
sra = scm_i_make_ra (1, 0);
- SCM_ARRAY_DIMS (sra)->lbnd = 0;
- SCM_ARRAY_DIMS (sra)->ubnd = len - 1;
- SCM_ARRAY_V (sra) = SCM_ARRAY_V (ra);
- SCM_ARRAY_BASE (sra) = SCM_ARRAY_BASE (ra);
- SCM_ARRAY_DIMS (sra)->inc = (ndim ? SCM_ARRAY_DIMS (ra)[ndim - 1].inc : 1);
+ SCM_I_ARRAY_DIMS (sra)->lbnd = 0;
+ SCM_I_ARRAY_DIMS (sra)->ubnd = len - 1;
+ SCM_I_ARRAY_V (sra) = SCM_I_ARRAY_V (ra);
+ SCM_I_ARRAY_BASE (sra) = SCM_I_ARRAY_BASE (ra);
+ SCM_I_ARRAY_DIMS (sra)->inc = (ndim ? SCM_I_ARRAY_DIMS (ra)[ndim - 1].inc : 1);
return sra;
}
- else if (SCM_ENCLOSED_ARRAYP (ra))
+ else if (SCM_I_ENCLOSED_ARRAYP (ra))
scm_wrong_type_arg_msg (NULL, 0, ra, "non-enclosed array");
else
scm_wrong_type_arg_msg (NULL, 0, ra, "array");
@@ -1272,28 +1282,28 @@ scm_ra2contig (SCM ra, int copy)
SCM ret;
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);
- if (SCM_ARRAY_CONTP (ra) && ((0 == k) || (1 == SCM_ARRAY_DIMS (ra)[k - 1].inc)))
+ for (k = SCM_I_ARRAY_NDIM (ra); k--;)
+ len *= SCM_I_ARRAY_DIMS (ra)[k].ubnd - SCM_I_ARRAY_DIMS (ra)[k].lbnd + 1;
+ k = SCM_I_ARRAY_NDIM (ra);
+ if (SCM_I_ARRAY_CONTP (ra) && ((0 == k) || (1 == SCM_I_ARRAY_DIMS (ra)[k - 1].inc)))
{
- if (!scm_is_bitvector (SCM_ARRAY_V (ra)))
+ if (!scm_is_bitvector (SCM_I_ARRAY_V (ra)))
return ra;
- if ((len == scm_c_bitvector_length (SCM_ARRAY_V (ra)) &&
- 0 == SCM_ARRAY_BASE (ra) % SCM_LONG_BIT &&
+ if ((len == scm_c_bitvector_length (SCM_I_ARRAY_V (ra)) &&
+ 0 == SCM_I_ARRAY_BASE (ra) % SCM_LONG_BIT &&
0 == len % SCM_LONG_BIT))
return ra;
}
ret = scm_i_make_ra (k, 0);
- SCM_ARRAY_BASE (ret) = 0;
+ SCM_I_ARRAY_BASE (ret) = 0;
while (k--)
{
- SCM_ARRAY_DIMS (ret)[k].lbnd = SCM_ARRAY_DIMS (ra)[k].lbnd;
- SCM_ARRAY_DIMS (ret)[k].ubnd = SCM_ARRAY_DIMS (ra)[k].ubnd;
- SCM_ARRAY_DIMS (ret)[k].inc = inc;
- inc *= SCM_ARRAY_DIMS (ra)[k].ubnd - SCM_ARRAY_DIMS (ra)[k].lbnd + 1;
+ SCM_I_ARRAY_DIMS (ret)[k].lbnd = SCM_I_ARRAY_DIMS (ra)[k].lbnd;
+ SCM_I_ARRAY_DIMS (ret)[k].ubnd = SCM_I_ARRAY_DIMS (ra)[k].ubnd;
+ SCM_I_ARRAY_DIMS (ret)[k].inc = inc;
+ inc *= SCM_I_ARRAY_DIMS (ra)[k].ubnd - SCM_I_ARRAY_DIMS (ra)[k].lbnd + 1;
}
- SCM_ARRAY_V (ret) = make_typed_vector (scm_array_type (ra), inc);
+ SCM_I_ARRAY_V (ret) = make_typed_vector (scm_array_type (ra), inc);
if (copy)
scm_array_copy_x (ra, ret);
return ret;
@@ -1325,15 +1335,15 @@ SCM_DEFINE (scm_uniform_array_read_x, "uniform-array-read!", 1, 3, 0,
{
return scm_uniform_vector_read_x (ura, port_or_fd, start, end);
}
- else if (SCM_ARRAYP (ura))
+ else if (SCM_I_ARRAYP (ura))
{
size_t base, vlen, cstart, cend;
SCM cra, ans;
cra = scm_ra2contig (ura, 0);
- base = SCM_ARRAY_BASE (cra);
- vlen = SCM_ARRAY_DIMS (cra)->inc *
- (SCM_ARRAY_DIMS (cra)->ubnd - SCM_ARRAY_DIMS (cra)->lbnd + 1);
+ base = SCM_I_ARRAY_BASE (cra);
+ vlen = SCM_I_ARRAY_DIMS (cra)->inc *
+ (SCM_I_ARRAY_DIMS (cra)->ubnd - SCM_I_ARRAY_DIMS (cra)->lbnd + 1);
cstart = 0;
cend = vlen;
@@ -1344,7 +1354,7 @@ SCM_DEFINE (scm_uniform_array_read_x, "uniform-array-read!", 1, 3, 0,
cend = scm_to_unsigned_integer (end, cstart, vlen);
}
- ans = scm_uniform_vector_read_x (SCM_ARRAY_V (cra), port_or_fd,
+ ans = scm_uniform_vector_read_x (SCM_I_ARRAY_V (cra), port_or_fd,
scm_from_size_t (base + cstart),
scm_from_size_t (base + cend));
@@ -1352,7 +1362,7 @@ SCM_DEFINE (scm_uniform_array_read_x, "uniform-array-read!", 1, 3, 0,
scm_array_copy_x (cra, ura);
return ans;
}
- else if (SCM_ENCLOSED_ARRAYP (ura))
+ else if (SCM_I_ENCLOSED_ARRAYP (ura))
scm_wrong_type_arg_msg (NULL, 0, ura, "non-enclosed array");
else
scm_wrong_type_arg_msg (NULL, 0, ura, "array");
@@ -1379,15 +1389,15 @@ SCM_DEFINE (scm_uniform_array_write, "uniform-array-write", 1, 3, 0,
{
return scm_uniform_vector_write (ura, port_or_fd, start, end);
}
- else if (SCM_ARRAYP (ura))
+ else if (SCM_I_ARRAYP (ura))
{
size_t base, vlen, cstart, cend;
SCM cra, ans;
cra = scm_ra2contig (ura, 1);
- base = SCM_ARRAY_BASE (cra);
- vlen = SCM_ARRAY_DIMS (cra)->inc *
- (SCM_ARRAY_DIMS (cra)->ubnd - SCM_ARRAY_DIMS (cra)->lbnd + 1);
+ base = SCM_I_ARRAY_BASE (cra);
+ vlen = SCM_I_ARRAY_DIMS (cra)->inc *
+ (SCM_I_ARRAY_DIMS (cra)->ubnd - SCM_I_ARRAY_DIMS (cra)->lbnd + 1);
cstart = 0;
cend = vlen;
@@ -1398,13 +1408,13 @@ SCM_DEFINE (scm_uniform_array_write, "uniform-array-write", 1, 3, 0,
cend = scm_to_unsigned_integer (end, cstart, vlen);
}
- ans = scm_uniform_vector_write (SCM_ARRAY_V (cra), port_or_fd,
+ ans = scm_uniform_vector_write (SCM_I_ARRAY_V (cra), port_or_fd,
scm_from_size_t (base + cstart),
scm_from_size_t (base + cend));
return ans;
}
- else if (SCM_ENCLOSED_ARRAYP (ura))
+ else if (SCM_I_ENCLOSED_ARRAYP (ura))
scm_wrong_type_arg_msg (NULL, 0, ura, "non-enclosed array");
else
scm_wrong_type_arg_msg (NULL, 0, ura, "array");
@@ -1550,8 +1560,8 @@ scm_t_uint32 *
scm_array_handle_bit_writable_elements (scm_t_array_handle *h)
{
SCM vec = h->array;
- if (SCM_ARRAYP (vec))
- vec = SCM_ARRAY_V (vec);
+ if (SCM_I_ARRAYP (vec))
+ vec = SCM_I_ARRAY_V (vec);
if (IS_BITVECTOR (vec))
return BITVECTOR_BITS (vec) + h->base/32;
scm_wrong_type_arg_msg (NULL, 0, h->array, "bit array");
@@ -2244,15 +2254,15 @@ ra2l (SCM ra, unsigned long base, unsigned long k)
SCM res = SCM_EOL;
long inc;
size_t i;
- int enclosed = SCM_ENCLOSED_ARRAYP (ra);
+ int enclosed = SCM_I_ENCLOSED_ARRAYP (ra);
- if (k == SCM_ARRAY_NDIM (ra))
- return scm_i_cvref (SCM_ARRAY_V (ra), base, enclosed);
+ if (k == SCM_I_ARRAY_NDIM (ra))
+ return scm_i_cvref (SCM_I_ARRAY_V (ra), base, enclosed);
- inc = SCM_ARRAY_DIMS (ra)[k].inc;
- if (SCM_ARRAY_DIMS (ra)[k].ubnd < SCM_ARRAY_DIMS (ra)[k].lbnd)
+ inc = SCM_I_ARRAY_DIMS (ra)[k].inc;
+ if (SCM_I_ARRAY_DIMS (ra)[k].ubnd < SCM_I_ARRAY_DIMS (ra)[k].lbnd)
return SCM_EOL;
- i = base + (1 + SCM_ARRAY_DIMS (ra)[k].ubnd - SCM_ARRAY_DIMS (ra)[k].lbnd) * inc;
+ i = base + (1 + SCM_I_ARRAY_DIMS (ra)[k].ubnd - SCM_I_ARRAY_DIMS (ra)[k].lbnd) * inc;
do
{
i -= inc;
@@ -2271,8 +2281,8 @@ SCM_DEFINE (scm_array_to_list, "array->list", 1, 0, 0,
{
if (scm_is_generalized_vector (v))
return scm_generalized_vector_to_list (v);
- else if (SCM_ARRAYP (v) || SCM_ENCLOSED_ARRAYP (v))
- return ra2l (v, SCM_ARRAY_BASE (v), 0);
+ else if (SCM_I_ARRAYP (v) || SCM_I_ENCLOSED_ARRAYP (v))
+ return ra2l (v, SCM_I_ARRAY_BASE (v), 0);
scm_wrong_type_arg_msg (NULL, 0, v, "array");
}
@@ -2419,18 +2429,18 @@ static int
scm_i_print_array_dimension (SCM array, int dim, int base, int enclosed,
SCM port, scm_print_state *pstate)
{
- scm_t_array_dim *dim_spec = SCM_ARRAY_DIMS (array) + dim;
+ scm_t_array_dim *dim_spec = SCM_I_ARRAY_DIMS (array) + dim;
long idx;
scm_putc ('(', port);
for (idx = dim_spec->lbnd; idx <= dim_spec->ubnd; idx++)
{
- if (dim < SCM_ARRAY_NDIM(array)-1)
+ if (dim < SCM_I_ARRAY_NDIM(array)-1)
scm_i_print_array_dimension (array, dim+1, base, enclosed,
port, pstate);
else
- scm_iprin1 (scm_i_cvref (SCM_ARRAY_V (array), base, enclosed),
+ scm_iprin1 (scm_i_cvref (SCM_I_ARRAY_V (array), base, enclosed),
port, pstate);
if (idx < dim_spec->ubnd)
scm_putc (' ', port);
@@ -2447,10 +2457,10 @@ scm_i_print_array_dimension (SCM array, int dim, int base, int enclosed,
static int
scm_i_print_array (SCM array, SCM port, scm_print_state *pstate)
{
- long ndim = SCM_ARRAY_NDIM (array);
- scm_t_array_dim *dim_specs = SCM_ARRAY_DIMS (array);
- SCM v = SCM_ARRAY_V (array);
- unsigned long base = SCM_ARRAY_BASE (array);
+ long ndim = SCM_I_ARRAY_NDIM (array);
+ scm_t_array_dim *dim_specs = SCM_I_ARRAY_DIMS (array);
+ SCM v = SCM_I_ARRAY_V (array);
+ unsigned long base = SCM_I_ARRAY_BASE (array);
long i;
int print_lbnds = 0, zero_size = 0, print_lens = 0;
@@ -2529,7 +2539,7 @@ scm_i_print_enclosed_array (SCM array, SCM port, scm_print_state *pstate)
size_t base;
scm_putc ('#', port);
- base = SCM_ARRAY_BASE (array);
+ base = SCM_I_ARRAY_BASE (array);
scm_puts ("<enclosed-array ", port);
scm_i_print_array_dimension (array, 0, base, 1, port, pstate);
scm_putc ('>', port);
@@ -2755,11 +2765,11 @@ SCM_DEFINE (scm_array_type, "array-type", 1, 0, 0,
"")
#define FUNC_NAME s_scm_array_type
{
- if (SCM_ARRAYP (ra))
- return scm_i_generalized_vector_type (SCM_ARRAY_V (ra));
+ if (SCM_I_ARRAYP (ra))
+ return scm_i_generalized_vector_type (SCM_I_ARRAY_V (ra));
else if (scm_is_generalized_vector (ra))
return scm_i_generalized_vector_type (ra);
- else if (SCM_ENCLOSED_ARRAYP (ra))
+ else if (SCM_I_ENCLOSED_ARRAYP (ra))
scm_wrong_type_arg_msg (NULL, 0, ra, "non-enclosed array");
else
scm_wrong_type_arg_msg (NULL, 0, ra, "array");
@@ -2775,11 +2785,11 @@ SCM_DEFINE (scm_array_prototype, "array-prototype", 1, 0, 0,
"@code{make-uniform-array}.")
#define FUNC_NAME s_scm_array_prototype
{
- if (SCM_ARRAYP (ra))
- return scm_i_get_old_prototype (SCM_ARRAY_V (ra));
+ if (SCM_I_ARRAYP (ra))
+ return scm_i_get_old_prototype (SCM_I_ARRAY_V (ra));
else if (scm_is_generalized_vector (ra))
return scm_i_get_old_prototype (ra);
- else if (SCM_ENCLOSED_ARRAYP (ra))
+ else if (SCM_I_ENCLOSED_ARRAYP (ra))
return SCM_UNSPECIFIED;
else
scm_wrong_type_arg_msg (NULL, 0, ra, "array");
@@ -2791,15 +2801,15 @@ SCM_DEFINE (scm_array_prototype, "array-prototype", 1, 0, 0,
static SCM
array_mark (SCM ptr)
{
- return SCM_ARRAY_V (ptr);
+ return SCM_I_ARRAY_V (ptr);
}
static size_t
array_free (SCM ptr)
{
- scm_gc_free (SCM_ARRAY_MEM (ptr),
- (sizeof (scm_t_array)
- + SCM_ARRAY_NDIM (ptr) * sizeof (scm_t_array_dim)),
+ scm_gc_free (SCM_I_ARRAY_MEM (ptr),
+ (sizeof (scm_i_t_array)
+ + SCM_I_ARRAY_NDIM (ptr) * sizeof (scm_t_array_dim)),
"array");
return 0;
}
@@ -2871,17 +2881,17 @@ scm_raprin1 (SCM exp, SCM port, scm_print_state *pstate)
void
scm_init_unif ()
{
- scm_tc16_array = scm_make_smob_type ("array", 0);
- scm_set_smob_mark (scm_tc16_array, array_mark);
- scm_set_smob_free (scm_tc16_array, array_free);
- scm_set_smob_print (scm_tc16_array, scm_i_print_array);
- scm_set_smob_equalp (scm_tc16_array, scm_array_equal_p);
-
- scm_tc16_enclosed_array = scm_make_smob_type ("enclosed-array", 0);
- scm_set_smob_mark (scm_tc16_enclosed_array, array_mark);
- scm_set_smob_free (scm_tc16_enclosed_array, array_free);
- scm_set_smob_print (scm_tc16_enclosed_array, scm_i_print_enclosed_array);
- scm_set_smob_equalp (scm_tc16_enclosed_array, scm_array_equal_p);
+ scm_i_tc16_array = scm_make_smob_type ("array", 0);
+ scm_set_smob_mark (scm_i_tc16_array, array_mark);
+ scm_set_smob_free (scm_i_tc16_array, array_free);
+ scm_set_smob_print (scm_i_tc16_array, scm_i_print_array);
+ scm_set_smob_equalp (scm_i_tc16_array, scm_array_equal_p);
+
+ scm_i_tc16_enclosed_array = scm_make_smob_type ("enclosed-array", 0);
+ scm_set_smob_mark (scm_i_tc16_enclosed_array, array_mark);
+ scm_set_smob_free (scm_i_tc16_enclosed_array, array_free);
+ scm_set_smob_print (scm_i_tc16_enclosed_array, scm_i_print_enclosed_array);
+ scm_set_smob_equalp (scm_i_tc16_enclosed_array, scm_array_equal_p);
scm_add_feature ("array");
diff --git a/libguile/unif.h b/libguile/unif.h
index 7c93027be..d458e43f0 100644
--- a/libguile/unif.h
+++ b/libguile/unif.h
@@ -41,36 +41,12 @@ typedef struct scm_t_array_dim
ssize_t inc;
} scm_t_array_dim;
-typedef struct scm_t_array
-{
- SCM v; /* the contents of the array, e.g., a vector or uniform vector. */
- unsigned long base;
-} scm_t_array;
-
-SCM_API scm_t_bits scm_tc16_array;
-SCM_API scm_t_bits scm_tc16_enclosed_array;
-
-#define SCM_ARRAY_FLAG_CONTIGUOUS (1 << 16)
-
-#define SCM_ARRAYP(a) SCM_TYP16_PREDICATE (scm_tc16_array, a)
-#define SCM_ENCLOSED_ARRAYP(a) SCM_TYP16_PREDICATE (scm_tc16_enclosed_array, a)
-#define SCM_ARRAY_NDIM(x) ((size_t) (SCM_CELL_WORD_0 (x) >> 17))
-#define SCM_ARRAY_CONTP(x) (SCM_CELL_WORD_0 (x) & SCM_ARRAY_FLAG_CONTIGUOUS)
-#define SCM_SET_ARRAY_CONTIGUOUS_FLAG(x) \
- (SCM_SET_CELL_WORD_0 ((x), SCM_CELL_WORD_0 (x) | SCM_ARRAY_FLAG_CONTIGUOUS))
-#define SCM_CLR_ARRAY_CONTIGUOUS_FLAG(x) \
- (SCM_SET_CELL_WORD_0 ((x), SCM_CELL_WORD_0 (x) & ~SCM_ARRAY_FLAG_CONTIGUOUS))
-
-#define SCM_ARRAY_MEM(a) ((scm_t_array *) SCM_CELL_WORD_1 (a))
-#define SCM_ARRAY_V(a) (SCM_ARRAY_MEM (a)->v)
-#define SCM_ARRAY_BASE(a) (SCM_ARRAY_MEM (a)->base)
-#define SCM_ARRAY_DIMS(a) ((scm_t_array_dim *)((char *) SCM_ARRAY_MEM (a) + sizeof (scm_t_array)))
-
SCM_API SCM scm_array_p (SCM v, SCM prot);
SCM_API SCM scm_typed_array_p (SCM v, SCM type);
SCM_API SCM scm_make_array (SCM fill, SCM bounds);
SCM_API SCM scm_make_typed_array (SCM type, SCM fill, SCM bounds);
SCM_API SCM scm_array_rank (SCM ra);
+SCM_API size_t scm_c_array_rank (SCM ra);
SCM_API SCM scm_array_dimensions (SCM ra);
SCM_API SCM scm_shared_array_root (SCM ra);
SCM_API SCM scm_shared_array_offset (SCM ra);
@@ -163,6 +139,29 @@ SCM_API scm_t_uint32 *scm_bitvector_writable_elements (SCM vec,
/* internal. */
+typedef struct scm_i_t_array
+{
+ SCM v; /* the contents of the array, e.g., a vector or uniform vector. */
+ unsigned long base;
+} scm_i_t_array;
+
+SCM_API scm_t_bits scm_i_tc16_array;
+SCM_API scm_t_bits scm_i_tc16_enclosed_array;
+
+#define SCM_I_ARRAY_FLAG_CONTIGUOUS (1 << 16)
+
+#define SCM_I_ARRAYP(a) SCM_TYP16_PREDICATE (scm_i_tc16_array, a)
+#define SCM_I_ENCLOSED_ARRAYP(a) \
+ SCM_TYP16_PREDICATE (scm_i_tc16_enclosed_array, a)
+#define SCM_I_ARRAY_NDIM(x) ((size_t) (SCM_CELL_WORD_0 (x) >> 17))
+#define SCM_I_ARRAY_CONTP(x) (SCM_CELL_WORD_0(x) & SCM_I_ARRAY_FLAG_CONTIGUOUS)
+
+#define SCM_I_ARRAY_MEM(a) ((scm_i_t_array *) SCM_CELL_WORD_1 (a))
+#define SCM_I_ARRAY_V(a) (SCM_I_ARRAY_MEM (a)->v)
+#define SCM_I_ARRAY_BASE(a) (SCM_I_ARRAY_MEM (a)->base)
+#define SCM_I_ARRAY_DIMS(a) \
+ ((scm_t_array_dim *)((char *) SCM_I_ARRAY_MEM (a) + sizeof (scm_i_t_array)))
+
SCM_API SCM scm_i_make_ra (int ndim, int enclosed);
SCM_API SCM scm_i_cvref (SCM v, size_t p, int enclosed);
SCM_API SCM scm_i_read_array (SCM port, int c);
@@ -181,6 +180,7 @@ SCM_API SCM scm_cvref (SCM v, unsigned long pos, SCM last);
SCM_API void scm_ra_set_contp (SCM ra);
SCM_API long scm_aind (SCM ra, SCM args, const char *what);
SCM_API int scm_raprin1 (SCM exp, SCM port, scm_print_state *pstate);
+
#endif
SCM_API void scm_init_unif (void);
diff --git a/libguile/vectors.c b/libguile/vectors.c
index f0225e6e8..79c20fd0a 100644
--- a/libguile/vectors.c
+++ b/libguile/vectors.c
@@ -43,9 +43,9 @@ scm_is_vector (SCM obj)
{
if (SCM_I_IS_VECTOR (obj))
return 1;
- if (SCM_ARRAYP (obj) && SCM_ARRAY_NDIM (obj) == 1)
+ if (SCM_I_ARRAYP (obj) && SCM_I_ARRAY_NDIM (obj) == 1)
{
- SCM v = SCM_ARRAY_V (obj);
+ SCM v = SCM_I_ARRAY_V (obj);
return SCM_I_IS_VECTOR (v);
}
return 0;
@@ -102,9 +102,9 @@ scm_vector_length (SCM v)
{
if (SCM_I_IS_VECTOR (v))
return scm_from_size_t (SCM_I_VECTOR_LENGTH (v));
- else if (SCM_ARRAYP (v) && SCM_ARRAY_NDIM (v) == 1)
+ else if (SCM_I_ARRAYP (v) && SCM_I_ARRAY_NDIM (v) == 1)
{
- scm_t_array_dim *dim = SCM_ARRAY_DIMS (v);
+ scm_t_array_dim *dim = SCM_I_ARRAY_DIMS (v);
return scm_from_size_t (dim->ubnd - dim->lbnd + 1);
}
else
@@ -196,15 +196,15 @@ scm_c_vector_ref (SCM v, size_t k)
scm_out_of_range (NULL, scm_from_size_t (k));
return (SCM_I_VECTOR_ELTS(v))[k];
}
- else if (SCM_ARRAYP (v) && SCM_ARRAY_NDIM (v) == 1)
+ else if (SCM_I_ARRAYP (v) && SCM_I_ARRAY_NDIM (v) == 1)
{
- scm_t_array_dim *dim = SCM_ARRAY_DIMS (v);
- SCM vv = SCM_ARRAY_V (v);
+ scm_t_array_dim *dim = SCM_I_ARRAY_DIMS (v);
+ SCM vv = SCM_I_ARRAY_V (v);
if (SCM_I_IS_VECTOR (vv))
{
if (k >= dim->ubnd - dim->lbnd + 1)
scm_out_of_range (NULL, scm_from_size_t (k));
- k = SCM_ARRAY_BASE (v) + k*dim->inc;
+ k = SCM_I_ARRAY_BASE (v) + k*dim->inc;
return (SCM_I_VECTOR_ELTS (vv))[k];
}
scm_wrong_type_arg_msg (NULL, 0, v, "non-uniform vector");
@@ -244,15 +244,15 @@ scm_c_vector_set_x (SCM v, size_t k, SCM obj)
scm_out_of_range (NULL, scm_from_size_t (k));
(SCM_I_VECTOR_WELTS(v))[k] = obj;
}
- else if (SCM_ARRAYP (v) && SCM_ARRAY_NDIM (v) == 1)
+ else if (SCM_I_ARRAYP (v) && SCM_I_ARRAY_NDIM (v) == 1)
{
- scm_t_array_dim *dim = SCM_ARRAY_DIMS (v);
- SCM vv = SCM_ARRAY_V (v);
+ scm_t_array_dim *dim = SCM_I_ARRAY_DIMS (v);
+ SCM vv = SCM_I_ARRAY_V (v);
if (SCM_I_IS_VECTOR (vv))
{
if (k >= dim->ubnd - dim->lbnd + 1)
scm_out_of_range (NULL, scm_from_size_t (k));
- k = SCM_ARRAY_BASE (v) + k*dim->inc;
+ k = SCM_I_ARRAY_BASE (v) + k*dim->inc;
(SCM_I_VECTOR_WELTS (vv))[k] = obj;
}
else