diff options
-rw-r--r-- | libguile/ramap.c | 390 | ||||
-rw-r--r-- | libguile/srfi-4.c | 24 | ||||
-rw-r--r-- | libguile/srfi-4.i.c | 4 | ||||
-rw-r--r-- | libguile/unif.c | 370 | ||||
-rw-r--r-- | libguile/unif.h | 50 | ||||
-rw-r--r-- | libguile/vectors.c | 24 |
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 |