mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-06-14 15:40:19 +02:00
* acconfig.h: add HAVE_ARRAYS.
* configure.in: add --disable-arrays option, probably temporary. * the following changes allow guile to be built with the array "module" omitted. some of this stuff is just tc7 type support, which wouldn't be needed if uniform array types were converted to smobs. * tag.c (scm_utag_bvect ... scm_utag_cvect): don't define unless HAVE_ARRAYS. (scm_tag): don't check array types unless HAVE_ARRAYS. * sort.c (scm_restricted_vector_sort_x, scm_sorted_p): remove the unused array types. * (scm_stable_sort, scm_sort): don't support vectors if not HAVE_ARRAYS. a bit excessive. * random.c (vector_scale, vector_sum_squares, scm_random_solid_sphere_x, scm_random_hollow_sphere_x, scm_random_normal_vector_x): don't define unless HAVE_ARRAYS. * gh_data.c (makvect, gh_chars2byvect, gh_shorts2svect, gh_longs2ivect, gh_ulongs2uvect, gh_floats2fvect, gh_doubles2dvect, gh_uniform_vector_length, gh_uniform_vector_ref): don't define unless HAVE_ARRAYS. (gh_scm2chars, gh_scm2shorts, gh_scm2longs, gh_scm2floats, gh_scm2doubles): don't check vector types if not HAVE_ARRAYS. * eq.c (scm_equal_p), eval.c (SCM_CEVAL), print.c (scm_iprin1), gc.c (scm_gc_mark, scm_gc_sweep), objects.c (scm_class_of): don't support the array types unless HAVE_ARRAYS is defined. * tags.h: make nine tc7 types conditional on HAVE_ARRAYS. * read.c (scm_lreadr): don't check for #* unless HAVE_ARRAYS is defined (this should use read-hash-extend). * ramap.c, unif.c: don't check whether ARRAYS is defined. * vectors.c (scm_vector_set_length_x): moved here from unif.c. call scm_uniform_element_size if HAVE_ARRAYS. vectors.h: prototype too. * unif.c (scm_uniform_element_size): new procedure. * init.c (scm_boot_guile_1): don't call scm_init_ramap or scm_init_unif unless HAVE_ARRAYS is defined. * __scm.h: don't define ARRAYS. * Makefile.am (EXTRA_libguile_la_SOURCES): unif.c and ramap.c moved here from libguile_la_SOURCES. * Makefile.am (ice9_sources): add arrays.scm. * boot-9.scm: load arrays.scm if 'array is provided. * arrays.scm: new file with stuff from boot-9.scm.
This commit is contained in:
parent
5c11cc9deb
commit
afe5177e7f
28 changed files with 268 additions and 211 deletions
|
@ -47,6 +47,76 @@
|
|||
#include "vectors.h"
|
||||
|
||||
|
||||
/*
|
||||
* This complicates things too much if allowed on any array.
|
||||
* C code can safely call it on arrays known to be used in a single
|
||||
* threaded manner.
|
||||
*
|
||||
* SCM_PROC(s_vector_set_length_x, "vector-set-length!", 2, 0, 0, scm_vector_set_length_x);
|
||||
*/
|
||||
static char s_vector_set_length_x[] = "vector-set-length!";
|
||||
|
||||
|
||||
SCM
|
||||
scm_vector_set_length_x (vect, len)
|
||||
SCM vect;
|
||||
SCM len;
|
||||
{
|
||||
long l;
|
||||
scm_sizet siz;
|
||||
scm_sizet sz;
|
||||
|
||||
l = SCM_INUM (len);
|
||||
SCM_ASRTGO (SCM_NIMP (vect), badarg1);
|
||||
|
||||
#ifdef HAVE_ARRAYS
|
||||
if (SCM_TYP7 (vect) == scm_tc7_bvect)
|
||||
{
|
||||
l = (l + SCM_LONG_BIT - 1) / SCM_LONG_BIT;
|
||||
}
|
||||
sz = scm_uniform_element_size (vect);
|
||||
if (sz == 0)
|
||||
#endif
|
||||
switch (SCM_TYP7 (vect))
|
||||
{
|
||||
default:
|
||||
badarg1: scm_wta (vect, (char *) SCM_ARG1, s_vector_set_length_x);
|
||||
case scm_tc7_string:
|
||||
SCM_ASRTGO (vect != scm_nullstr, badarg1);
|
||||
sz = sizeof (char);
|
||||
l++;
|
||||
break;
|
||||
case scm_tc7_vector:
|
||||
case scm_tc7_wvect:
|
||||
SCM_ASRTGO (vect != scm_nullvect, badarg1);
|
||||
sz = sizeof (SCM);
|
||||
break;
|
||||
}
|
||||
SCM_ASSERT (SCM_INUMP (len), len, SCM_ARG2, s_vector_set_length_x);
|
||||
if (!l)
|
||||
l = 1L;
|
||||
siz = l * sz;
|
||||
if (siz != l * sz)
|
||||
scm_wta (SCM_MAKINUM (l * sz), (char *) SCM_NALLOC, s_vector_set_length_x);
|
||||
SCM_REDEFER_INTS;
|
||||
SCM_SETCHARS (vect,
|
||||
((char *)
|
||||
scm_must_realloc (SCM_CHARS (vect),
|
||||
(long) SCM_LENGTH (vect) * sz,
|
||||
(long) siz,
|
||||
s_vector_set_length_x)));
|
||||
if (SCM_VECTORP (vect))
|
||||
{
|
||||
sz = SCM_LENGTH (vect);
|
||||
while (l > sz)
|
||||
SCM_VELTS (vect)[--l] = SCM_UNSPECIFIED;
|
||||
}
|
||||
else if (SCM_STRINGP (vect))
|
||||
SCM_CHARS (vect)[l - 1] = 0;
|
||||
SCM_SETLENGTH (vect, SCM_INUM (len), SCM_TYP7 (vect));
|
||||
SCM_REALLOW_INTS;
|
||||
return vect;
|
||||
}
|
||||
|
||||
SCM_PROC(s_vector_p, "vector?", 1, 0, 0, scm_vector_p);
|
||||
|
||||
|
@ -263,5 +333,7 @@ void
|
|||
scm_init_vectors ()
|
||||
{
|
||||
#include "vectors.x"
|
||||
/*
|
||||
scm_make_subr (s_resizuve, scm_tc7_subr_2, scm_vector_set_length_x); */
|
||||
}
|
||||
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue