-/* Copyright (C) 1995,1996,1997,1998, 2000 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1998,2000,2001 Free Software Foundation, Inc.
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
\f
#include <stdio.h>
+#include <errno.h>
+#include <string.h>
+
#include "libguile/_scm.h"
#include "libguile/chars.h"
#include "libguile/eval.h"
#include <unistd.h>
#endif
+#ifdef HAVE_IO_H
+#include <io.h>
+#endif
+
\f
/* The set of uniform scm_vector types is:
* Vector of: Called:
* long long llvect
*/
-scm_bits_t scm_tc16_array;
+scm_t_bits scm_tc16_array;
/* return the size of an element in a uniform array or 0 if type not
found. */
-scm_sizet
+size_t
scm_uniform_element_size (SCM obj)
{
- scm_sizet result;
+ size_t result;
switch (SCM_TYP7 (obj))
{
#ifdef HAVE_LONG_LONGS
case scm_tc7_llvect:
- result = sizeof (long_long);
+ result = sizeof (long long);
break;
#endif
else if (SCM_CHARP (prot))
{
i = sizeof (char) * k;
- return scm_makstr (i, 0);
+ return scm_allocate_string (i);
}
else if (SCM_INUMP (prot))
{
#ifdef HAVE_LONG_LONGS
else if (s == 'l')
{
- i = sizeof (long_long) * k;
+ i = sizeof (long long) * k;
type = scm_tc7_llvect;
}
#endif
else
{
- return scm_make_vector (SCM_MAKINUM (k), SCM_UNDEFINED);
+ return scm_c_make_vector (k, SCM_UNDEFINED);
}
}
else if (!SCM_INEXACTP (prot))
/* Huge non-unif vectors are NOT supported. */
/* no special scm_vector */
- return scm_make_vector (SCM_MAKINUM (k), SCM_UNDEFINED);
+ return scm_c_make_vector (k, SCM_UNDEFINED);
else if (singp (prot))
{
i = sizeof (float) * k;
SCM_DEFINE (scm_uniform_vector_length, "uniform-vector-length", 1, 0, 0,
- (SCM v),
- "Returns the number of elements in @var{uve}.")
+ (SCM v),
+ "Return the number of elements in @var{uve}.")
#define FUNC_NAME s_scm_uniform_vector_length
{
SCM_ASRTGO (SCM_NIMP (v), badarg1);
switch SCM_TYP7 (v)
{
default:
- badarg1:SCM_WTA(1,v);
+ badarg1:SCM_WRONG_TYPE_ARG (1, v);
case scm_tc7_vector:
case scm_tc7_wvect:
return SCM_MAKINUM (SCM_VECTOR_LENGTH (v));
SCM_DEFINE (scm_array_p, "array?", 1, 1, 0,
(SCM v, SCM prot),
- "Returns @code{#t} if the @var{obj} is an array, and @code{#f} if not.\n\n"
- "The @var{prototype} argument is used with uniform arrays and is described\n"
- "elsewhere.")
+ "Return @code{#t} if the @var{obj} is an array, and @code{#f} if\n"
+ "not. The @var{prototype} argument is used with uniform arrays\n"
+ "and is described elsewhere.")
#define FUNC_NAME s_scm_array_p
{
int nprot;
SCM_DEFINE (scm_array_rank, "array-rank", 1, 0, 0,
(SCM ra),
- "Returns the number of dimensions of @var{obj}. If @var{obj} is not an\n"
- "array, @code{0} is returned.")
+ "Return the number of dimensions of @var{obj}. If @var{obj} is\n"
+ "not an array, @code{0} is returned.")
#define FUNC_NAME s_scm_array_rank
{
if (SCM_IMP (ra))
(SCM ra),
"@code{Array-dimensions} is similar to @code{array-shape} but replaces\n"
"elements with a @code{0} minimum with one greater than the maximum. So:\n"
- "@example\n"
+ "@lisp\n"
"(array-dimensions (make-array 'foo '(-1 3) 5)) @result{} ((-1 3) 5)\n"
- "@end example")
+ "@end lisp")
#define FUNC_NAME s_scm_array_dimensions
{
SCM res = SCM_EOL;
- scm_sizet k;
- scm_array_dim *s;
+ size_t k;
+ scm_t_array_dim *s;
if (SCM_IMP (ra))
return SCM_BOOL_F;
switch (SCM_TYP7 (ra))
#define FUNC_NAME s_scm_shared_array_increments
{
SCM res = SCM_EOL;
- scm_sizet k;
- scm_array_dim *s;
+ size_t k;
+ scm_t_array_dim *s;
SCM_ASSERT (SCM_ARRAYP (ra), ra, SCM_ARG1, FUNC_NAME);
k = SCM_ARRAY_NDIM (ra);
s = SCM_ARRAY_DIMS (ra);
long
scm_aind (SCM ra, SCM args, const char *what)
+#define FUNC_NAME what
{
SCM ind;
register long j;
- register scm_sizet pos = SCM_ARRAY_BASE (ra);
- register scm_sizet k = SCM_ARRAY_NDIM (ra);
- scm_array_dim *s = SCM_ARRAY_DIMS (ra);
+ register unsigned long pos = SCM_ARRAY_BASE (ra);
+ register unsigned long k = SCM_ARRAY_NDIM (ra);
+ scm_t_array_dim *s = SCM_ARRAY_DIMS (ra);
if (SCM_INUMP (args))
{
- SCM_ASSERT (1 == k, scm_makfrom0str (what), SCM_WNA, NULL);
+ if (k != 1)
+ scm_error_num_args_subr (what);
return pos + (SCM_INUM (args) - s->lbnd) * (s->inc);
}
- while (k && SCM_NIMP (args))
+ while (k && !SCM_NULLP (args))
{
ind = SCM_CAR (args);
args = SCM_CDR (args);
- SCM_ASSERT (SCM_INUMP (ind), ind, s_bad_ind, what);
+ if (!SCM_INUMP (ind))
+ scm_misc_error (what, s_bad_ind, SCM_EOL);
j = SCM_INUM (ind);
if (j < s->lbnd || j > s->ubnd)
scm_out_of_range (what, ind);
k--;
s++;
}
- SCM_ASSERT (0 == k && SCM_NULLP (args), scm_makfrom0str (what), SCM_WNA,
- NULL);
+ if (k != 0 || !SCM_NULLP (args))
+ scm_error_num_args_subr (what);
+
return pos;
}
-
+#undef FUNC_NAME
SCM
SCM ra;
SCM_NEWCELL (ra);
SCM_DEFER_INTS;
- SCM_NEWSMOB(ra, ((long) ndim << 17) + scm_tc16_array,
- scm_must_malloc ((long) (sizeof (scm_array) + ndim * sizeof (scm_array_dim)),
+ SCM_NEWSMOB(ra, ((scm_t_bits) ndim << 17) + scm_tc16_array,
+ scm_must_malloc ((sizeof (scm_t_array) +
+ ndim * sizeof (scm_t_array_dim)),
"array"));
SCM_ARRAY_V (ra) = scm_nullvect;
SCM_ALLOW_INTS;
SCM
scm_shap2ra (SCM args, const char *what)
{
- scm_array_dim *s;
+ scm_t_array_dim *s;
SCM ra, spec, sp;
int ndim = scm_ilength (args);
- SCM_ASSERT (0 <= ndim, args, s_bad_spec, what);
+ if (ndim < 0)
+ scm_misc_error (what, s_bad_spec, SCM_EOL);
+
ra = scm_make_ra (ndim);
SCM_ARRAY_BASE (ra) = 0;
s = SCM_ARRAY_DIMS (ra);
spec = SCM_CAR (args);
if (SCM_INUMP (spec))
{
- SCM_ASSERT (SCM_INUM (spec) >= 0, spec, s_bad_spec, what);
+ if (SCM_INUM (spec) < 0)
+ scm_misc_error (what, s_bad_spec, SCM_EOL);
s->lbnd = 0;
s->ubnd = SCM_INUM (spec) - 1;
s->inc = 1;
}
else
{
- SCM_ASSERT (SCM_CONSP (spec) && SCM_INUMP (SCM_CAR (spec)), spec,
- s_bad_spec, what);
+ if (!SCM_CONSP (spec) || !SCM_INUMP (SCM_CAR (spec)))
+ scm_misc_error (what, s_bad_spec, SCM_EOL);
s->lbnd = SCM_INUM (SCM_CAR (spec));
sp = SCM_CDR (spec);
- SCM_ASSERT (SCM_CONSP (sp)
- && SCM_INUMP (SCM_CAR (sp)) && SCM_NULLP (SCM_CDR (sp)),
- spec, s_bad_spec, what);
+ if (!SCM_CONSP (sp)
+ || !SCM_INUMP (SCM_CAR (sp))
+ || !SCM_NULLP (SCM_CDR (sp)))
+ scm_misc_error (what, s_bad_spec, SCM_EOL);
s->ubnd = SCM_INUM (SCM_CAR (sp));
s->inc = 1;
}
}
SCM_DEFINE (scm_dimensions_to_uniform_array, "dimensions->uniform-array", 2, 1, 0,
- (SCM dims, SCM prot, SCM fill),
+ (SCM dims, SCM prot, SCM fill),
"@deffnx primitive make-uniform-vector length prototype [fill]\n"
- "Creates and returns a uniform array or vector of type corresponding to\n"
- "@var{prototype} with dimensions @var{dims} or length @var{length}. If\n"
- "@var{fill} is supplied, it's used to fill the array, otherwise \n"
- "@var{prototype} is used.")
+ "Create and return a uniform array or vector of type\n"
+ "corresponding to @var{prototype} with dimensions @var{dims} or\n"
+ "length @var{length}. If @var{fill} is supplied, it's used to\n"
+ "fill the array, otherwise @var{prototype} is used.")
#define FUNC_NAME s_scm_dimensions_to_uniform_array
{
- scm_sizet k;
- unsigned long int rlen = 1;
- scm_array_dim *s;
+ size_t k;
+ unsigned long rlen = 1;
+ scm_t_array_dim *s;
SCM ra;
+
if (SCM_INUMP (dims))
{
SCM answer = scm_make_uve (SCM_INUM (dims), prot);
scm_array_fill_x (answer, prot);
return answer;
}
+
SCM_ASSERT (SCM_NULLP (dims) || SCM_CONSP (dims),
dims, SCM_ARG1, FUNC_NAME);
ra = scm_shap2ra (dims, FUNC_NAME);
- SCM_SETOR_CAR (ra, SCM_ARRAY_CONTIGUOUS);
+ SCM_SET_ARRAY_CONTIGUOUS_FLAG (ra);
s = SCM_ARRAY_DIMS (ra);
k = SCM_ARRAY_NDIM (ra);
+
while (k--)
{
s[k].inc = rlen;
void
scm_ra_set_contp (SCM ra)
{
- scm_sizet k = SCM_ARRAY_NDIM (ra);
+ size_t k = SCM_ARRAY_NDIM (ra);
if (k)
{
long inc = SCM_ARRAY_DIMS (ra)[k - 1].inc;
{
if (inc != SCM_ARRAY_DIMS (ra)[k].inc)
{
- SCM_SETAND_CAR (ra, ~SCM_ARRAY_CONTIGUOUS);
+ SCM_CLR_ARRAY_CONTIGUOUS_FLAG (ra);
return;
}
inc *= (SCM_ARRAY_DIMS (ra)[k].ubnd
- SCM_ARRAY_DIMS (ra)[k].lbnd + 1);
}
}
- SCM_SETOR_CAR (ra, SCM_ARRAY_CONTIGUOUS);
+ SCM_SET_ARRAY_CONTIGUOUS_FLAG (ra);
}
"the new array into coordinates in the old array. A @var{mapper} must be\n"
"linear, and its range must stay within the bounds of the old array, but\n"
"it can be otherwise arbitrary. A simple example:\n"
- "@example\n"
+ "@lisp\n"
"(define fred (make-array #f 8 8))\n"
"(define freds-diagonal\n"
" (make-shared-array fred (lambda (i) (list i i)) 8))\n"
"(define freds-center\n"
" (make-shared-array fred (lambda (i j) (list (+ 3 i) (+ 3 j))) 2 2))\n"
"(array-ref freds-center 0 0) @result{} foo\n"
- "@end example")
+ "@end lisp")
#define FUNC_NAME s_scm_make_shared_array
{
SCM ra;
SCM inds, indptr;
SCM imap;
- scm_sizet i, k;
+ size_t k, i;
long old_min, new_min, old_max, new_max;
- scm_array_dim *s;
+ scm_t_array_dim *s;
+
+ SCM_VALIDATE_REST_ARGUMENT (dims);
SCM_VALIDATE_ARRAY (1,oldra);
SCM_VALIDATE_PROC (2,mapfunc);
ra = scm_shap2ra (dims, FUNC_NAME);
return ra;
}
}
- imap = scm_apply (mapfunc, scm_reverse (inds), SCM_EOL);
+ imap = scm_apply_0 (mapfunc, scm_reverse (inds));
if (SCM_ARRAYP (oldra))
- i = (scm_sizet) scm_aind (oldra, imap, FUNC_NAME);
+ i = (size_t) scm_aind (oldra, imap, FUNC_NAME);
else
{
if (SCM_NINUMP (imap))
{
- SCM_ASSERT (1 == scm_ilength (imap) && SCM_INUMP (SCM_CAR (imap)),
- imap, s_bad_ind, FUNC_NAME);
+ if (scm_ilength (imap) != 1 || !SCM_INUMP (SCM_CAR (imap)))
+ SCM_MISC_ERROR (s_bad_ind, SCM_EOL);
imap = SCM_CAR (imap);
}
i = SCM_INUM (imap);
if (s[k].ubnd > s[k].lbnd)
{
SCM_SETCAR (indptr, SCM_MAKINUM (SCM_INUM (SCM_CAR (indptr)) + 1));
- imap = scm_apply (mapfunc, scm_reverse (inds), SCM_EOL);
+ imap = scm_apply_0 (mapfunc, scm_reverse (inds));
if (SCM_ARRAYP (oldra))
s[k].inc = scm_aind (oldra, imap, FUNC_NAME) - i;
else
{
if (SCM_NINUMP (imap))
-
{
- SCM_ASSERT (1 == scm_ilength (imap) && SCM_INUMP (SCM_CAR (imap)),
- imap, s_bad_ind, FUNC_NAME);
+ if (scm_ilength (imap) != 1 || !SCM_INUMP (SCM_CAR (imap)))
+ SCM_MISC_ERROR (s_bad_ind, SCM_EOL);
imap = SCM_CAR (imap);
}
s[k].inc = (long) SCM_INUM (imap) - i;
s[k].inc = new_max - new_min + 1; /* contiguous by default */
indptr = SCM_CDR (indptr);
}
- SCM_ASSERT (old_min <= new_min && old_max >= new_max, SCM_UNDEFINED,
- "mapping out of range", FUNC_NAME);
+ 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))
{
SCM v = SCM_ARRAY_V (ra);
/* args are RA . DIMS */
SCM_DEFINE (scm_transpose_array, "transpose-array", 1, 0, 1,
(SCM ra, SCM args),
- "Returns an array sharing contents with @var{array}, but with dimensions\n"
- "arranged in a different order. There must be one @var{dim} argument for\n"
- "each dimension of @var{array}. @var{dim0}, @var{dim1}, @dots{} should\n"
- "be integers between 0 and the rank of the array to be returned. Each\n"
- "integer in that range must appear at least once in the argument list.\n\n"
- "The values of @var{dim0}, @var{dim1}, @dots{} correspond to dimensions\n"
- "in the array to be returned, their positions in the argument list to\n"
- "dimensions of @var{array}. Several @var{dim}s may have the same value,\n"
- "in which case the returned array will have smaller rank than\n"
- "@var{array}.\n\n"
- "examples:\n"
- "@example\n"
+ "Return an array sharing contents with @var{array}, but with\n"
+ "dimensions arranged in a different order. There must be one\n"
+ "@var{dim} argument for each dimension of @var{array}.\n"
+ "@var{dim0}, @var{dim1}, @dots{} should be integers between 0\n"
+ "and the rank of the array to be returned. Each integer in that\n"
+ "range must appear at least once in the argument list.\n"
+ "\n"
+ "The values of @var{dim0}, @var{dim1}, @dots{} correspond to\n"
+ "dimensions in the array to be returned, their positions in the\n"
+ "argument list to dimensions of @var{array}. Several @var{dim}s\n"
+ "may have the same value, in which case the returned array will\n"
+ "have smaller rank than @var{array}.\n"
+ "\n"
+ "@lisp\n"
"(transpose-array '#2((a b) (c d)) 1 0) @result{} #2((a c) (b d))\n"
"(transpose-array '#2((a b) (c d)) 0 0) @result{} #1(a d)\n"
"(transpose-array '#3(((a b c) (d e f)) ((1 2 3) (4 5 6))) 1 1 0) @result{}\n"
" #2((a 4) (b 5) (c 6))\n"
- "@end example")
+ "@end lisp")
#define FUNC_NAME s_scm_transpose_array
{
SCM res, vargs, *ve = &vargs;
- scm_array_dim *s, *r;
+ scm_t_array_dim *s, *r;
int ndim, i, k;
+ SCM_VALIDATE_REST_ARGUMENT (args);
SCM_ASSERT (SCM_NIMP (ra), ra, SCM_ARG1, FUNC_NAME);
switch (SCM_TYP7 (ra))
{
default:
- badarg:SCM_WTA (1,ra);
+ badarg:SCM_WRONG_TYPE_ARG (1, ra);
case scm_tc7_bvect:
case scm_tc7_string:
case scm_tc7_byvect:
#ifdef HAVE_LONG_LONGS
case scm_tc7_llvect:
#endif
- SCM_ASSERT (!SCM_NULLP (args) && SCM_NULLP (SCM_CDR (args)),
- scm_makfrom0str (FUNC_NAME), SCM_WNA, NULL);
- SCM_ASSERT (SCM_INUMP (SCM_CAR (args)), SCM_CAR (args), SCM_ARG2,
- FUNC_NAME);
+ if (SCM_NULLP (args) || !SCM_NULLP (SCM_CDR (args)))
+ SCM_WRONG_NUM_ARGS ();
+ SCM_VALIDATE_INUM (SCM_ARG2, SCM_CAR (args));
SCM_ASSERT_RANGE (SCM_ARG2, SCM_CAR (args),
SCM_EQ_P (SCM_INUM0, SCM_CAR (args)));
return ra;
case scm_tc7_smob:
SCM_ASRTGO (SCM_ARRAYP (ra), badarg);
vargs = scm_vector (args);
- SCM_ASSERT (SCM_VECTOR_LENGTH (vargs) == SCM_ARRAY_NDIM (ra),
- scm_makfrom0str (FUNC_NAME), SCM_WNA, NULL);
- ve = SCM_VELTS (vargs);
+ if (SCM_VECTOR_LENGTH (vargs) != SCM_ARRAY_NDIM (ra))
+ SCM_WRONG_NUM_ARGS ();
+ ve = SCM_VELTS (vargs);
ndim = 0;
for (k = 0; k < SCM_ARRAY_NDIM (ra); k++)
{
r->inc += s->inc;
}
}
- SCM_ASSERT (ndim <= 0, args, "bad argument list", FUNC_NAME);
+ if (ndim > 0)
+ SCM_MISC_ERROR ("bad argument list", SCM_EOL);
scm_ra_set_contp (res);
return res;
}
"@code{eq?}. The value returned by @var{array-prototype} when given an\n"
"enclosed array is unspecified.\n\n"
"examples:\n"
- "@example\n"
+ "@lisp\n"
"(enclose-array '#3(((a b c) (d e f)) ((1 2 3) (4 5 6))) 1) @result{}\n"
" #<enclosed-array (#1(a d) #1(b e) #1(c f)) (#1(1 4) #1(2 5) #1(3 6))>\n\n"
"(enclose-array '#3(((a b c) (d e f)) ((1 2 3) (4 5 6))) 1 0) @result{}\n"
" #<enclosed-array #2((a 1) (d 4)) #2((b 2) (e 5)) #2((c 3) (f 6))>\n"
- "@end example")
+ "@end lisp")
#define FUNC_NAME s_scm_enclose_array
{
SCM axv, res, ra_inr;
- scm_array_dim vdim, *s = &vdim;
+ scm_t_array_dim vdim, *s = &vdim;
int ndim, j, k, ninr, noutr;
+ SCM_VALIDATE_REST_ARGUMENT (axes);
if (SCM_NULLP (axes))
axes = scm_cons ((SCM_ARRAYP (ra) ? SCM_MAKINUM (SCM_ARRAY_NDIM (ra) - 1) : SCM_INUM0), SCM_EOL);
ninr = scm_ilength (axes);
- SCM_ASSERT (0 <= ninr, scm_makfrom0str (FUNC_NAME), SCM_WNA, NULL);
+ if (ninr < 0)
+ SCM_WRONG_NUM_ARGS ();
ra_inr = scm_make_ra (ninr);
SCM_ASRTGO (SCM_NIMP (ra), badarg1);
switch SCM_TYP7 (ra)
{
default:
- badarg1:SCM_WTA (1,ra);
+ badarg1:SCM_WRONG_TYPE_ARG (1, ra);
case scm_tc7_string:
case scm_tc7_bvect:
case scm_tc7_byvect:
break;
}
noutr = ndim - ninr;
+ if (noutr < 0)
+ SCM_WRONG_NUM_ARGS ();
axv = scm_make_string (SCM_MAKINUM (ndim), SCM_MAKE_CHAR (0));
- SCM_ASSERT (0 <= noutr, scm_makfrom0str (FUNC_NAME), SCM_WNA, NULL);
res = scm_make_ra (noutr);
SCM_ARRAY_BASE (res) = SCM_ARRAY_BASE (ra_inr);
SCM_ARRAY_V (res) = ra_inr;
for (k = 0; k < ninr; k++, axes = SCM_CDR (axes))
{
- SCM_ASSERT (SCM_INUMP (SCM_CAR (axes)), SCM_CAR (axes), "bad axis", FUNC_NAME);
+ if (!SCM_INUMP (SCM_CAR (axes)))
+ SCM_MISC_ERROR ("bad axis", SCM_EOL);
j = SCM_INUM (SCM_CAR (axes));
SCM_ARRAY_DIMS (ra_inr)[k].lbnd = s[j].lbnd;
SCM_ARRAY_DIMS (ra_inr)[k].ubnd = s[j].ubnd;
SCM_DEFINE (scm_array_in_bounds_p, "array-in-bounds?", 1, 0, 1,
(SCM v, SCM args),
- "Returns @code{#t} if its arguments would be acceptable to array-ref.")
+ "Return @code{#t} if its arguments would be acceptable to\n"
+ "@code{array-ref}.")
#define FUNC_NAME s_scm_array_in_bounds_p
{
SCM ind = SCM_EOL;
long pos = 0;
- register scm_sizet k;
+ register size_t k;
register long j;
- scm_array_dim *s;
+ scm_t_array_dim *s;
+ SCM_VALIDATE_REST_ARGUMENT (args);
SCM_ASRTGO (SCM_NIMP (v), badarg1);
if (SCM_NIMP (args))
switch SCM_TYP7 (v)
{
default:
- badarg1:SCM_WTA (1,v);
- wna: scm_wrong_num_args (scm_makfrom0str (FUNC_NAME));
+ badarg1:SCM_WRONG_TYPE_ARG (1, v);
+ wna: SCM_WRONG_NUM_ARGS ();
case scm_tc7_smob:
k = SCM_ARRAY_NDIM (v);
s = SCM_ARRAY_DIMS (v);
ind = SCM_CAR (args);
args = SCM_CDR (args);
s++;
- SCM_ASSERT (SCM_INUMP (ind), ind, s_bad_ind, FUNC_NAME);
+ if (!SCM_INUMP (ind))
+ SCM_MISC_ERROR (s_bad_ind, SCM_EOL);
}
SCM_ASRTGO (0 == k, wna);
v = SCM_ARRAY_V (v);
SCM_DEFINE (scm_uniform_vector_ref, "uniform-vector-ref", 2, 0, 0,
(SCM v, SCM args),
"@deffnx primitive array-ref v . args\n"
- "Returns the element at the @code{(index1, index2)} element in @var{array}.")
+ "Return the element at the @code{(index1, index2)} element in\n"
+ "@var{array}.")
#define FUNC_NAME s_scm_uniform_vector_ref
{
long pos;
if (SCM_NULLP (args))
return v;
badarg:
- SCM_WTA (1,v);
- abort ();
+ SCM_WRONG_TYPE_ARG (1, v);
+ /* not reached */
outrng:
scm_out_of_range (FUNC_NAME, SCM_MAKINUM (pos));
wna:
- scm_wrong_num_args (SCM_FUNC_NAME);
+ SCM_WRONG_NUM_ARGS ();
case scm_tc7_smob:
{ /* enclosed */
int k = SCM_ARRAY_NDIM (v);
case scm_tc7_uvect:
return scm_ulong2num (((unsigned long *) SCM_VELTS (v))[pos]);
case scm_tc7_ivect:
- return scm_long2num(((signed long *) SCM_VELTS (v))[pos]);
+ return scm_long2num (((signed long *) SCM_VELTS (v))[pos]);
case scm_tc7_svect:
return SCM_MAKINUM (((short *) SCM_CELL_WORD_1 (v))[pos]);
#ifdef HAVE_LONG_LONGS
case scm_tc7_llvect:
- return scm_long_long2num (((long_long *) SCM_CELL_WORD_1 (v))[pos]);
+ return scm_long_long2num (((long long *) SCM_CELL_WORD_1 (v))[pos]);
#endif
case scm_tc7_fvect:
tries to recycle conses. (Make *sure* you want them recycled.) */
SCM
-scm_cvref (SCM v, scm_sizet pos, SCM last)
+scm_cvref (SCM v, unsigned long pos, SCM last)
+#define FUNC_NAME "scm_cvref"
{
switch SCM_TYP7 (v)
{
default:
- scm_wta (v, (char *) SCM_ARG1, "PROGRAMMING ERROR: scm_cvref");
+ SCM_WRONG_TYPE_ARG (SCM_ARG1, v);
case scm_tc7_bvect:
if (SCM_BITVEC_REF(v,pos))
return SCM_BOOL_T;
return SCM_MAKINUM (((short *) SCM_CELL_WORD_1 (v))[pos]);
#ifdef HAVE_LONG_LONGS
case scm_tc7_llvect:
- return scm_long_long2num (((long_long *) SCM_CELL_WORD_1 (v))[pos]);
+ return scm_long_long2num (((long long *) SCM_CELL_WORD_1 (v))[pos]);
#endif
case scm_tc7_fvect:
if (SCM_NIMP (last) && !SCM_EQ_P (last, scm_flo0) && SCM_SLOPPY_REALP (last))
}
}
}
+#undef FUNC_NAME
+
SCM_REGISTER_PROC(s_uniform_array_set1_x, "uniform-array-set1!", 3, 0, 0, scm_array_set_x);
#define FUNC_NAME s_scm_array_set_x
{
long pos = 0;
+
SCM_ASRTGO (SCM_NIMP (v), badarg1);
if (SCM_ARRAYP (v))
{
else
{
unsigned long int length;
- if (SCM_NIMP (args))
+ if (SCM_CONSP (args))
{
- SCM_ASSERT (SCM_CONSP(args) && SCM_INUMP (SCM_CAR (args)), args,
- SCM_ARG3, FUNC_NAME);
+ SCM_ASSERT (SCM_INUMP (SCM_CAR (args)), args, SCM_ARG3, FUNC_NAME);
SCM_ASRTGO (SCM_NULLP (SCM_CDR (args)), wna);
pos = SCM_INUM (SCM_CAR (args));
}
switch (SCM_TYP7 (v))
{
default: badarg1:
- SCM_WTA (1,v);
- abort ();
+ SCM_WRONG_TYPE_ARG (1, v);
+ /* not reached */
outrng:
scm_out_of_range (FUNC_NAME, SCM_MAKINUM (pos));
wna:
- scm_wrong_num_args (SCM_FUNC_NAME);
+ SCM_WRONG_NUM_ARGS ();
case scm_tc7_smob: /* enclosed */
goto badarg1;
case scm_tc7_bvect:
else if (SCM_EQ_P (obj, SCM_BOOL_T))
SCM_BITVEC_SET(v,pos);
else
- badobj:SCM_WTA (2,obj);
+ badobj:SCM_WRONG_TYPE_ARG (2, obj);
break;
case scm_tc7_string:
SCM_ASRTGO (SCM_CHARP (obj), badobj);
((char *) SCM_UVECTOR_BASE (v))[pos] = SCM_INUM (obj);
break;
case scm_tc7_uvect:
- SCM_VELTS(v)[pos] = SCM_PACK (scm_num2ulong(obj, (char *)SCM_ARG2, FUNC_NAME));
+ ((unsigned long *) SCM_UVECTOR_BASE (v))[pos]
+ = scm_num2ulong (obj, SCM_ARG2, FUNC_NAME);
break;
case scm_tc7_ivect:
- SCM_VELTS(v)[pos] = SCM_PACK (scm_num2long(obj, (char *)SCM_ARG2, FUNC_NAME));
+ ((long *) SCM_UVECTOR_BASE (v))[pos]
+ = scm_num2long (obj, SCM_ARG2, FUNC_NAME);
break;
case scm_tc7_svect:
SCM_ASRTGO (SCM_INUMP (obj), badobj);
- ((short *) SCM_CELL_WORD_1 (v))[pos] = SCM_INUM (obj);
+ ((short *) SCM_UVECTOR_BASE (v))[pos] = SCM_INUM (obj);
break;
#ifdef HAVE_LONG_LONGS
case scm_tc7_llvect:
- ((long_long *) SCM_CELL_WORD_1 (v))[pos] = scm_num2long_long (obj, (char *)SCM_ARG2, FUNC_NAME);
+ ((long long *) SCM_UVECTOR_BASE (v))[pos]
+ = scm_num2long_long (obj, SCM_ARG2, FUNC_NAME);
break;
#endif
-
-
case scm_tc7_fvect:
- ((float *) SCM_CELL_WORD_1 (v))[pos] = (float) scm_num2dbl (obj, FUNC_NAME);
+ ((float *) SCM_UVECTOR_BASE (v))[pos]
+ = (float) scm_num2dbl (obj, FUNC_NAME);
break;
case scm_tc7_dvect:
- ((double *) SCM_CELL_WORD_1 (v))[pos] = scm_num2dbl (obj, FUNC_NAME);
+ ((double *) SCM_UVECTOR_BASE (v))[pos]
+ = scm_num2dbl (obj, FUNC_NAME);
break;
case scm_tc7_cvect:
SCM_ASRTGO (SCM_INEXACTP (obj), badobj);
if (SCM_REALP (obj)) {
- ((double *) SCM_CELL_WORD_1 (v))[2 * pos] = SCM_REAL_VALUE (obj);
- ((double *) SCM_CELL_WORD_1 (v))[2 * pos + 1] = 0.0;
+ ((double *) SCM_UVECTOR_BASE (v))[2 * pos] = SCM_REAL_VALUE (obj);
+ ((double *) SCM_UVECTOR_BASE (v))[2 * pos + 1] = 0.0;
} else {
- ((double *) SCM_CELL_WORD_1 (v))[2 * pos] = SCM_COMPLEX_REAL (obj);
- ((double *) SCM_CELL_WORD_1 (v))[2 * pos + 1] = SCM_COMPLEX_IMAG (obj);
+ ((double *) SCM_UVECTOR_BASE (v))[2 * pos] = SCM_COMPLEX_REAL (obj);
+ ((double *) SCM_UVECTOR_BASE (v))[2 * pos + 1] = SCM_COMPLEX_IMAG (obj);
}
break;
case scm_tc7_vector:
return ra;
case scm_tc7_smob:
{
- scm_sizet k, ndim = SCM_ARRAY_NDIM (ra), len = 1;
+ size_t k, ndim = SCM_ARRAY_NDIM (ra), len = 1;
if (!SCM_ARRAYP (ra) || !SCM_ARRAY_CONTP (ra))
return SCM_BOOL_F;
for (k = 0; k < ndim; k++)
{
SCM ret;
long inc = 1;
- scm_sizet k, len = 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);
switch SCM_TYP7 (v)
{
default:
- badarg1:SCM_WTA (SCM_ARG1,v);
+ badarg1:SCM_WRONG_TYPE_ARG (SCM_ARG1, v);
case scm_tc7_smob:
SCM_ASRTGO (SCM_ARRAYP (v), badarg1);
cra = scm_ra2contig (ra, 0);
#ifdef HAVE_LONG_LONGS
case scm_tc7_llvect:
base = (char *) SCM_UVECTOR_BASE (v);
- sz = sizeof (long_long);
+ sz = sizeof (long long);
break;
#endif
case scm_tc7_fvect:
if (SCM_NIMP (port_or_fd))
{
- scm_port *pt = SCM_PTAB_ENTRY (port_or_fd);
+ scm_t_port *pt = SCM_PTAB_ENTRY (port_or_fd);
int remaining = (cend - offset) * sz;
char *dest = base + (cstart + offset) * sz;
{
SCM_SYSCALL (ans = read (SCM_INUM (port_or_fd),
base + (cstart + offset) * sz,
- (scm_sizet) (sz * (cend - offset))));
+ (sz * (cend - offset))));
if (ans == -1)
SCM_SYSERROR;
}
switch SCM_TYP7 (v)
{
default:
- badarg1:SCM_WTA (1, v);
+ badarg1:SCM_WRONG_TYPE_ARG (1, v);
case scm_tc7_smob:
SCM_ASRTGO (SCM_ARRAYP (v), badarg1);
v = scm_ra2contig (v, 1);
#ifdef HAVE_LONG_LONGS
case scm_tc7_llvect:
base = (char *) SCM_UVECTOR_BASE (v);
- sz = sizeof (long_long);
+ sz = sizeof (long long);
break;
#endif
case scm_tc7_fvect:
{
SCM_SYSCALL (ans = write (SCM_INUM (port_or_fd),
base + (cstart + offset) * sz,
- (scm_sizet) (sz * (cend - offset))));
+ (sz * (cend - offset))));
if (ans == -1)
SCM_SYSERROR;
}
{0, 1, 1, 2, 1, 2, 2, 3, 1, 2, 2, 3, 2, 3, 3, 4};
SCM_DEFINE (scm_bit_count, "bit-count", 2, 0, 0,
- (SCM b, SCM bitvector),
- "Returns the number of occurrences of the boolean B in BITVECTOR.")
+ (SCM b, SCM bitvector),
+ "Return the number of occurrences of the boolean @var{b} in\n"
+ "@var{bitvector}.")
#define FUNC_NAME s_scm_bit_count
{
SCM_VALIDATE_BOOL (1, b);
SCM_DEFINE (scm_bit_position, "bit-position", 3, 0, 0,
(SCM item, SCM v, SCM k),
- "Returns the minimum index of an occurrence of @var{bool} in @var{bv}\n"
- "which is at least @var{k}. If no @var{bool} occurs within the specified\n"
- "range @code{#f} is returned.")
+ "Return the minimum index of an occurrence of @var{bool} in\n"
+ "@var{bv} which is at least @var{k}. If no @var{bool} occurs\n"
+ "within the specified range @code{#f} is returned.")
#define FUNC_NAME s_scm_bit_position
{
long i, lenw, xbits, pos;
SCM_DEFINE (scm_bit_set_star_x, "bit-set*!", 3, 0, 0,
- (SCM v, SCM kv, SCM obj),
- "If uve is a bit-vector @var{bv} and uve must be of the same length. If\n"
- "@var{bool} is @code{#t}, uve is OR'ed into @var{bv}; If @var{bool} is @code{#f}, the\n"
- "inversion of uve is AND'ed into @var{bv}.\n\n"
- "If uve is a unsigned integer vector all the elements of uve must be\n"
- "between 0 and the @code{LENGTH} of @var{bv}. The bits of @var{bv}\n"
- "corresponding to the indexes in uve are set to @var{bool}.\n\n"
- "The return value is unspecified.")
+ (SCM v, SCM kv, SCM obj),
+ "If uve is a bit-vector @var{bv} and uve must be of the same\n"
+ "length. If @var{bool} is @code{#t}, uve is OR'ed into\n"
+ "@var{bv}; If @var{bool} is @code{#f}, the inversion of uve is\n"
+ "AND'ed into @var{bv}.\n\n"
+ "If uve is a unsigned integer vector all the elements of uve\n"
+ "must be between 0 and the @code{length} of @var{bv}. The bits\n"
+ "of @var{bv} corresponding to the indexes in uve are set to\n"
+ "@var{bool}. The return value is unspecified.")
#define FUNC_NAME s_scm_bit_set_star_x
{
register long i, k, vlen;
switch SCM_TYP7 (kv)
{
default:
- badarg2:SCM_WTA (2,kv);
+ badarg2:SCM_WRONG_TYPE_ARG (2, kv);
case scm_tc7_uvect:
vlen = SCM_BITVECTOR_LENGTH (v);
if (SCM_FALSEP (obj))
SCM_BITVEC_SET(v,k);
}
else
- badarg3:SCM_WTA (3,obj);
+ badarg3:SCM_WRONG_TYPE_ARG (3, obj);
break;
case scm_tc7_bvect:
SCM_ASSERT (SCM_BITVECTOR_LENGTH (v) == SCM_BITVECTOR_LENGTH (kv), v, SCM_ARG1, FUNC_NAME);
if (SCM_FALSEP (obj))
for (k = (SCM_BITVECTOR_LENGTH (v) + SCM_LONG_BIT - 1) / SCM_LONG_BIT; k--;)
- SCM_UNPACK (SCM_VELTS (v)[k]) &= ~ SCM_UNPACK(SCM_VELTS (kv)[k]);
+ SCM_BITVECTOR_BASE (v) [k] &= ~SCM_BITVECTOR_BASE (kv) [k];
else if (SCM_EQ_P (obj, SCM_BOOL_T))
for (k = (SCM_BITVECTOR_LENGTH (v) + SCM_LONG_BIT - 1) / SCM_LONG_BIT; k--;)
- SCM_UNPACK (SCM_VELTS (v)[k]) |= SCM_UNPACK (SCM_VELTS (kv)[k]);
+ SCM_BITVECTOR_BASE (v) [k] |= SCM_BITVECTOR_BASE (kv) [k];
else
goto badarg3;
break;
SCM_DEFINE (scm_bit_count_star, "bit-count*", 3, 0, 0,
(SCM v, SCM kv, SCM obj),
- "Returns\n"
- "@example\n"
+ "Return\n"
+ "@lisp\n"
"(bit-count (bit-set*! (if bool bv (bit-invert! bv)) uve #t) #t).\n"
- "@end example\n"
+ "@end lisp\n"
"@var{bv} is not modified.")
#define FUNC_NAME s_scm_bit_count_star
{
{
default:
badarg2:
- SCM_WTA (2,kv);
+ SCM_WRONG_TYPE_ARG (2, kv);
case scm_tc7_uvect:
vlen = SCM_BITVECTOR_LENGTH (v);
if (SCM_FALSEP (obj))
count++;
}
else
- badarg3:SCM_WTA (3,obj);
+ badarg3:SCM_WRONG_TYPE_ARG (3, obj);
break;
case scm_tc7_bvect:
SCM_ASSERT (SCM_BITVECTOR_LENGTH (v) == SCM_BITVECTOR_LENGTH (kv), v, SCM_ARG1, FUNC_NAME);
k = SCM_BITVECTOR_LENGTH (v);
for (k = (k + SCM_LONG_BIT - 1) / SCM_LONG_BIT; k--;)
- SCM_UNPACK (SCM_VELTS (v)[k]) = ~SCM_UNPACK (SCM_VELTS (v)[k]);
+ SCM_BITVECTOR_BASE (v) [k] = ~SCM_BITVECTOR_BASE (v) [k];
return SCM_UNSPECIFIED;
}
static SCM
-ra2l (SCM ra,scm_sizet base,scm_sizet k)
+ra2l (SCM ra,unsigned long base,unsigned long k)
{
register SCM res = SCM_EOL;
register long inc = SCM_ARRAY_DIMS (ra)[k].inc;
- register scm_sizet i;
+ register size_t i;
if (SCM_ARRAY_DIMS (ra)[k].ubnd < SCM_ARRAY_DIMS (ra)[k].lbnd)
return SCM_EOL;
i = base + (1 + SCM_ARRAY_DIMS (ra)[k].ubnd - SCM_ARRAY_DIMS (ra)[k].lbnd) * inc;
}
-SCM_DEFINE (scm_array_to_list, "array->list", 1, 0, 0,
+SCM_DEFINE (scm_t_arrayo_list, "array->list", 1, 0, 0,
(SCM v),
- "Returns a list consisting of all the elements, in order, of @var{array}.")
-#define FUNC_NAME s_scm_array_to_list
+ "Return a list consisting of all the elements, in order, of\n"
+ "@var{array}.")
+#define FUNC_NAME s_scm_t_arrayo_list
{
SCM res = SCM_EOL;
register long k;
switch SCM_TYP7 (v)
{
default:
- badarg1:SCM_WTA (1,v);
+ badarg1:SCM_WRONG_TYPE_ARG (1, v);
case scm_tc7_smob:
SCM_ASRTGO (SCM_ARRAYP (v), badarg1);
return ra2l (v, SCM_ARRAY_BASE (v), 0);
res = scm_cons (SCM_BOOL(((long *) data)[k] & mask), res);
return res;
}
- case scm_tc7_uvect: {
- long *data = (long *)SCM_VELTS(v);
- for (k = SCM_UVECTOR_LENGTH(v) - 1; k >= 0; k--)
- res = scm_cons(scm_ulong2num(data[k]), res);
- return res;
- }
- case scm_tc7_ivect: {
- long *data = (long *)SCM_VELTS(v);
- for (k = SCM_UVECTOR_LENGTH(v) - 1; k >= 0; k--)
- res = scm_cons(scm_long2num(data[k]), res);
- return res;
- }
- case scm_tc7_svect: {
- short *data;
- data = (short *)SCM_VELTS(v);
- for (k = SCM_UVECTOR_LENGTH(v) - 1; k >= 0; k--)
- res = scm_cons(SCM_MAKINUM (data[k]), res);
- return res;
- }
+ case scm_tc7_byvect:
+ {
+ signed char *data = (signed char *) SCM_VELTS (v);
+ unsigned long k = SCM_UVECTOR_LENGTH (v);
+ while (k != 0)
+ res = scm_cons (SCM_MAKINUM (data[--k]), res);
+ return res;
+ }
+ case scm_tc7_uvect:
+ {
+ long *data = (long *)SCM_VELTS(v);
+ for (k = SCM_UVECTOR_LENGTH(v) - 1; k >= 0; k--)
+ res = scm_cons(scm_ulong2num(data[k]), res);
+ return res;
+ }
+ case scm_tc7_ivect:
+ {
+ long *data = (long *)SCM_VELTS(v);
+ for (k = SCM_UVECTOR_LENGTH(v) - 1; k >= 0; k--)
+ res = scm_cons(scm_long2num(data[k]), res);
+ return res;
+ }
+ case scm_tc7_svect:
+ {
+ short *data = (short *)SCM_VELTS(v);
+ for (k = SCM_UVECTOR_LENGTH(v) - 1; k >= 0; k--)
+ res = scm_cons(scm_short2num (data[k]), res);
+ return res;
+ }
#ifdef HAVE_LONG_LONGS
- case scm_tc7_llvect: {
- long_long *data;
- data = (long_long *)SCM_VELTS(v);
- for (k = SCM_UVECTOR_LENGTH(v) - 1; k >= 0; k--)
- res = scm_cons(scm_long_long2num(data[k]), res);
- return res;
- }
+ case scm_tc7_llvect:
+ {
+ long long *data = (long long *)SCM_VELTS(v);
+ for (k = SCM_UVECTOR_LENGTH(v) - 1; k >= 0; k--)
+ res = scm_cons(scm_long_long2num(data[k]), res);
+ return res;
+ }
#endif
-
-
case scm_tc7_fvect:
{
float *data = (float *) SCM_VELTS (v);
#undef FUNC_NAME
-static char s_bad_ralst[] = "Bad scm_array contents list";
-
-static int l2ra(SCM lst, SCM ra, scm_sizet base, scm_sizet k);
+static int l2ra(SCM lst, SCM ra, unsigned long base, unsigned long k);
SCM_DEFINE (scm_list_to_uniform_array, "list->uniform-array", 3, 0, 0,
(SCM ndim, SCM prot, SCM lst),
"@deffnx procedure list->uniform-vector prot lst\n"
- "Returns a uniform array of the type indicated by prototype @var{prot}\n"
- "with elements the same as those of @var{lst}. Elements must be of the\n"
- "appropriate type, no coercions are done.")
+ "Return a uniform array of the type indicated by prototype\n"
+ "@var{prot} with elements the same as those of @var{lst}.\n"
+ "Elements must be of the appropriate type, no coercions are\n"
+ "done.")
#define FUNC_NAME s_scm_list_to_uniform_array
{
SCM shp = SCM_EOL;
SCM row = lst;
SCM ra;
- scm_sizet k;
+ unsigned long k;
long n;
SCM_VALIDATE_INUM_COPY (1,ndim,k);
while (k--)
ra = scm_dimensions_to_uniform_array (scm_reverse (shp), prot,
SCM_UNDEFINED);
if (SCM_NULLP (shp))
-
{
SCM_ASRTGO (1 == scm_ilength (lst), badlst);
scm_array_set_x (ra, SCM_CAR (lst), SCM_EOL);
if (l2ra (lst, ra, SCM_ARRAY_BASE (ra), 0))
return ra;
else
- badlst:scm_wta (lst, s_bad_ralst, FUNC_NAME);
- return SCM_BOOL_F;
+ badlst:SCM_MISC_ERROR ("Bad scm_array contents list: ~S",
+ scm_list_1 (lst));
}
#undef FUNC_NAME
static int
-l2ra (SCM lst, SCM ra, scm_sizet base, scm_sizet k)
+l2ra (SCM lst, SCM ra, unsigned long base, unsigned long k)
{
register long inc = SCM_ARRAY_DIMS (ra)[k].inc;
register long n = (1 + SCM_ARRAY_DIMS (ra)[k].ubnd - SCM_ARRAY_DIMS (ra)[k].lbnd);
static void
-rapr1 (SCM ra,scm_sizet j,scm_sizet k,SCM port,scm_print_state *pstate)
+rapr1 (SCM ra,unsigned long j,unsigned long k,SCM port,scm_print_state *pstate)
{
long inc = 1;
- long n = SCM_INUM (scm_uniform_vector_length (ra));
+ long n = (SCM_TYP7 (ra) == scm_tc7_smob
+ ? 0
+ : SCM_INUM (scm_uniform_vector_length (ra)));
int enclosed = 0;
tail:
switch SCM_TYP7 (ra)
}
break;
}
- if SCM_ARRAY_NDIM
- (ra)
+ if (SCM_ARRAY_NDIM (ra) > 0)
{ /* Could be zero-dimensional */
inc = SCM_ARRAY_DIMS (ra)[k].inc;
n = (SCM_ARRAY_DIMS (ra)[k].ubnd - SCM_ARRAY_DIMS (ra)[k].lbnd + 1);
scm_raprin1 (SCM exp, SCM port, scm_print_state *pstate)
{
SCM v = exp;
- scm_sizet base = 0;
+ unsigned long base = 0;
scm_putc ('#', port);
tail:
switch SCM_TYP7 (v)
scm_putc ('*', port);
for (i = 0; i < (SCM_BITVECTOR_LENGTH (exp)) / SCM_LONG_BIT; i++)
{
- scm_bits_t w = SCM_UNPACK (SCM_VELTS (exp)[i]);
+ scm_t_bits w = SCM_UNPACK (SCM_VELTS (exp)[i]);
for (j = SCM_LONG_BIT; j; j--)
{
scm_putc (w & 1 ? '1' : '0', port);
SCM_DEFINE (scm_array_prototype, "array-prototype", 1, 0, 0,
(SCM ra),
- "Returns an object that would produce an array of the same type as\n"
- "@var{array}, if used as the @var{prototype} for\n"
+ "Return an object that would produce an array of the same type\n"
+ "as @var{array}, if used as the @var{prototype} for\n"
"@code{make-uniform-array}.")
#define FUNC_NAME s_scm_array_prototype
{
switch SCM_TYP7 (ra)
{
default:
- badarg:SCM_WTA (1,ra);
+ badarg:SCM_WRONG_TYPE_ARG (1, ra);
case scm_tc7_smob:
SCM_ASRTGO (SCM_ARRAYP (ra), badarg);
if (enclosed++)
}
-static scm_sizet
+static size_t
array_free (SCM ptr)
{
scm_must_free (SCM_ARRAY_MEM (ptr));
- return sizeof (scm_array) + SCM_ARRAY_NDIM (ptr) * sizeof (scm_array_dim);
+ return sizeof (scm_t_array) +
+ SCM_ARRAY_NDIM (ptr) * sizeof (scm_t_array_dim);
}
void
HCoop / bpt / guile.git / blobdiff