summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--libguile/convert.c4
-rw-r--r--libguile/convert.h2
-rw-r--r--libguile/convert.i.c25
-rw-r--r--libguile/deprecated.c2
-rw-r--r--libguile/environments.c16
-rw-r--r--libguile/eval.c66
-rw-r--r--libguile/filesys.c81
-rw-r--r--libguile/fluids.c17
-rw-r--r--libguile/gc-mark.c17
-rw-r--r--libguile/gh.h2
-rw-r--r--libguile/gh_data.c72
-rw-r--r--libguile/goops.c53
-rw-r--r--libguile/hash.c15
-rw-r--r--libguile/init.c2
-rw-r--r--libguile/modules.c2
-rw-r--r--libguile/net_db.c34
-rw-r--r--libguile/objects.c6
-rw-r--r--libguile/ports.c6
-rw-r--r--libguile/posix.c49
-rw-r--r--libguile/print.c23
-rw-r--r--libguile/random.c71
-rw-r--r--libguile/read.c2
-rw-r--r--libguile/regex-posix.c6
-rw-r--r--libguile/scmsigs.c32
-rw-r--r--libguile/socket.c30
-rw-r--r--libguile/stime.c74
-rw-r--r--libguile/symbols.c4
-rw-r--r--libguile/tags.h2
-rw-r--r--libguile/vports.c18
29 files changed, 371 insertions, 362 deletions
diff --git a/libguile/convert.c b/libguile/convert.c
index f3305076b..d43c14b37 100644
--- a/libguile/convert.c
+++ b/libguile/convert.c
@@ -25,9 +25,7 @@
#include "libguile/strings.h"
#include "libguile/vectors.h"
#include "libguile/pairs.h"
-#if SCM_HAVE_ARRAYS
-# include "libguile/unif.h"
-#endif
+#include "libguile/unif.h"
#include "libguile/srfi-4.h"
#include "libguile/convert.h"
diff --git a/libguile/convert.h b/libguile/convert.h
index da7d379c9..f461c149b 100644
--- a/libguile/convert.h
+++ b/libguile/convert.h
@@ -38,7 +38,6 @@ SCM_API SCM scm_c_longs2scm (const long *src, long n);
SCM_API SCM scm_c_floats2scm (const float *src, long n);
SCM_API SCM scm_c_doubles2scm (const double *src, long n);
-#if SCM_HAVE_ARRAYS
SCM_API SCM scm_c_chars2byvect (const char *src, long n);
SCM_API SCM scm_c_shorts2svect (const short *src, long n);
SCM_API SCM scm_c_ints2ivect (const int *src, long n);
@@ -47,6 +46,5 @@ SCM_API SCM scm_c_longs2ivect (const long *src, long n);
SCM_API SCM scm_c_ulongs2uvect (const unsigned long *src, long n);
SCM_API SCM scm_c_floats2fvect (const float *src, long n);
SCM_API SCM scm_c_doubles2dvect (const double *src, long n);
-#endif
#endif /* SCM_CONVERT_H */
diff --git a/libguile/convert.i.c b/libguile/convert.i.c
index ec3c55406..5c30430b9 100644
--- a/libguile/convert.i.c
+++ b/libguile/convert.i.c
@@ -66,19 +66,19 @@
CTYPE *
SCM2CTYPES (SCM obj, CTYPE *data)
{
- size_t len, i;
+ scm_t_array_handle handle;
+ size_t i, len;
+ ssize_t inc;
const UVEC_CTYPE *uvec_elements;
obj = F(scm_any_to_,UVEC_TAG,vector) (obj);
- len = scm_c_uniform_vector_length (obj);
- uvec_elements = F(scm_,UVEC_TAG,vector_elements) (obj);
+ uvec_elements = F(scm_,UVEC_TAG,vector_elements) (obj, &handle, &len, &inc);
if (data == NULL)
data = scm_malloc (len * sizeof (CTYPE));
- for (i = 0; i < len; i++)
+ for (i = 0; i < len; i++, uvec_elements += inc)
data[i] = uvec_elements[i];
- scm_uniform_vector_release_elements (obj);
return data;
}
@@ -93,7 +93,7 @@ CTYPES2SCM (const CTYPE *data, long n)
v = scm_c_make_vector (n, SCM_UNSPECIFIED);
for (i = 0; i < n; i++)
- SCM_VECTOR_SET (v, i, FROM_CTYPE (data[i]));
+ SCM_SIMPLE_VECTOR_SET (v, i, FROM_CTYPE (data[i]));
return v;
}
@@ -103,17 +103,17 @@ CTYPES2SCM (const CTYPE *data, long n)
SCM
CTYPES2UVECT (const CTYPE *data, long n)
{
+ scm_t_array_handle handle;
long i;
SCM uvec;
UVEC_CTYPE *uvec_elements;
uvec = F(scm_make_,UVEC_TAG,vector) (scm_from_long (n), SCM_UNDEFINED);
- uvec_elements = F(scm_,UVEC_TAG,vector_writable_elements) (uvec);
-
+ uvec_elements = F(scm_,UVEC_TAG,vector_writable_elements) (uvec, &handle,
+ NULL, NULL);
for (i = 0; i < n; i++)
uvec_elements[i] = data[i];
- scm_uniform_vector_release_writable_elements (uvec);
return uvec;
}
@@ -122,17 +122,18 @@ CTYPES2UVECT (const CTYPE *data, long n)
SCM
CTYPES2UVECT_2 (const CTYPE_2 *data, long n)
{
+ scm_t_array_handle handle;
long i;
SCM uvec;
UVEC_CTYPE_2 *uvec_elements;
uvec = F(scm_make_,UVEC_TAG_2,vector) (scm_from_long (n), SCM_UNDEFINED);
- uvec_elements = F(scm_,UVEC_TAG_2,vector_elements) (obj);
+ uvec_elements = F(scm_,UVEC_TAG_2,vector_writable_elements) (uvec, &handle,
+ NULL, NULL);
for (i = 0; i < n; i++)
- v[i] = data[i];
+ uvec_elements[i] = data[i];
- scm_uniform_vector_release (uvec);
return uvec;
}
diff --git a/libguile/deprecated.c b/libguile/deprecated.c
index 8b4aa0c2e..9b8e69591 100644
--- a/libguile/deprecated.c
+++ b/libguile/deprecated.c
@@ -1058,7 +1058,7 @@ SCM_DEFINE (scm_gentemp, "gentemp", 0, 2, 0,
if (SCM_UNBNDP (obarray))
return scm_gensym (prefix);
else
- SCM_ASSERT ((SCM_VECTORP (obarray) || SCM_WVECTP (obarray)),
+ SCM_ASSERT ((scm_is_vector (obarray) || SCM_I_WVECTP (obarray)),
obarray,
SCM_ARG2,
FUNC_NAME);
diff --git a/libguile/environments.c b/libguile/environments.c
index dc2d5fee2..9ea4c4e1d 100644
--- a/libguile/environments.c
+++ b/libguile/environments.c
@@ -509,7 +509,7 @@ obarray_enter (SCM obarray, SCM symbol, SCM data)
{
size_t hash = scm_i_symbol_hash (symbol) % SCM_HASHTABLE_N_BUCKETS (obarray);
SCM entry = scm_cons (symbol, data);
- SCM slot = scm_cons (entry, SCM_HASHTABLE_BUCKETS (obarray)[hash]);
+ SCM slot = scm_cons (entry, SCM_HASHTABLE_BUCKET (obarray, hash));
SCM_SET_HASHTABLE_BUCKET (obarray, hash, slot);
if (SCM_HASHTABLE_N_ITEMS (obarray) > SCM_HASHTABLE_UPPER (obarray))
scm_i_rehash (obarray, scm_i_hash_symbol, 0, "obarray_enter");
@@ -530,7 +530,7 @@ obarray_replace (SCM obarray, SCM symbol, SCM data)
SCM lsym;
SCM slot;
- for (lsym = SCM_HASHTABLE_BUCKETS (obarray)[hash];
+ for (lsym = SCM_HASHTABLE_BUCKET (obarray, hash);
!scm_is_null (lsym);
lsym = SCM_CDR (lsym))
{
@@ -542,7 +542,7 @@ obarray_replace (SCM obarray, SCM symbol, SCM data)
}
}
- slot = scm_cons (new_entry, SCM_HASHTABLE_BUCKETS (obarray)[hash]);
+ slot = scm_cons (new_entry, SCM_HASHTABLE_BUCKET (obarray, hash));
SCM_SET_HASHTABLE_BUCKET (obarray, hash, slot);
if (SCM_HASHTABLE_N_ITEMS (obarray) > SCM_HASHTABLE_UPPER (obarray))
scm_i_rehash (obarray, scm_i_hash_symbol, 0, "obarray_replace");
@@ -560,7 +560,7 @@ obarray_retrieve (SCM obarray, SCM sym)
size_t hash = scm_i_symbol_hash (sym) % SCM_HASHTABLE_N_BUCKETS (obarray);
SCM lsym;
- for (lsym = SCM_HASHTABLE_BUCKETS (obarray)[hash];
+ for (lsym = SCM_HASHTABLE_BUCKET (obarray, hash);
!scm_is_null (lsym);
lsym = SCM_CDR (lsym))
{
@@ -581,7 +581,7 @@ static SCM
obarray_remove (SCM obarray, SCM sym)
{
size_t hash = scm_i_symbol_hash (sym) % SCM_HASHTABLE_N_BUCKETS (obarray);
- SCM table_entry = SCM_HASHTABLE_BUCKETS (obarray)[hash];
+ SCM table_entry = SCM_HASHTABLE_BUCKET (obarray, hash);
SCM handle = scm_sloppy_assq (sym, table_entry);
if (scm_is_pair (handle))
@@ -634,9 +634,9 @@ struct core_environments_base {
#define CORE_ENVIRONMENT_WEAK_OBSERVER_VECTOR(env) \
(CORE_ENVIRONMENTS_BASE (env)->weak_observers)
#define CORE_ENVIRONMENT_WEAK_OBSERVERS(env) \
- (SCM_VELTS (CORE_ENVIRONMENT_WEAK_OBSERVER_VECTOR (env)) [0])
+ (scm_c_vector_ref (CORE_ENVIRONMENT_WEAK_OBSERVER_VECTOR (env), 0))
#define SCM_SET_CORE_ENVIRONMENT_WEAK_OBSERVERS(env, v) \
- (SCM_VECTOR_SET (CORE_ENVIRONMENT_WEAK_OBSERVER_VECTOR (env), 0, (v)))
+ (scm_c_vector_set_x (CORE_ENVIRONMENT_WEAK_OBSERVER_VECTOR (env), 0, (v)))
@@ -887,7 +887,7 @@ leaf_environment_fold (SCM env, scm_environment_folder proc, SCM data, SCM init)
for (i = 0; i < SCM_HASHTABLE_N_BUCKETS (obarray); i++)
{
SCM l;
- for (l = SCM_HASHTABLE_BUCKETS (obarray)[i];
+ for (l = SCM_HASHTABLE_BUCKET (obarray, i);
!scm_is_null (l);
l = SCM_CDR (l))
{
diff --git a/libguile/eval.c b/libguile/eval.c
index cc17b6184..c7aae957a 100644
--- a/libguile/eval.c
+++ b/libguile/eval.c
@@ -559,7 +559,7 @@ unmemoize_expression (const SCM expr, const SCM env)
const SCM sym = scm_module_reverse_lookup (scm_env_module (env), expr);
return scm_is_true (sym) ? sym : sym_three_question_marks;
}
- else if (SCM_VECTORP (expr))
+ else if (scm_is_simple_vector (expr))
{
return scm_list_2 (scm_sym_quote, expr);
}
@@ -1879,16 +1879,8 @@ iqq (SCM form, SCM env, unsigned long int depth)
return scm_cons (iqq (SCM_CAR (form), env, depth),
iqq (SCM_CDR (form), env, depth));
}
- else if (SCM_VECTORP (form))
- {
- size_t i = SCM_VECTOR_LENGTH (form);
- SCM const *const data = SCM_VELTS (form);
- SCM tmp = SCM_EOL;
- while (i != 0)
- tmp = scm_cons (data[--i], tmp);
- scm_remember_upto_here_1 (form);
- return scm_vector (iqq (tmp, env, depth));
- }
+ else if (scm_is_vector (form))
+ return scm_vector (iqq (scm_vector_to_list (form), env, depth));
else
return form;
}
@@ -3755,7 +3747,7 @@ dispatch:
* complicated one, and a simple one. For the complicated one
* explained below, tmp holds a number that is used in the
* computation. */
- if (SCM_VECTORP (tmp))
+ if (scm_is_simple_vector (tmp))
{
/* This method of determining the hash value is much
* simpler: Set the hash value to zero and just perform a
@@ -3763,7 +3755,7 @@ dispatch:
method_cache = tmp;
mask = (unsigned long int) ((long) -1);
hash_value = 0;
- cache_end_pos = SCM_VECTOR_LENGTH (method_cache);
+ cache_end_pos = SCM_SIMPLE_VECTOR_LENGTH (method_cache);
}
else
{
@@ -3814,7 +3806,7 @@ dispatch:
do
{
SCM args = arg1; /* list of arguments */
- z = SCM_VELTS (method_cache)[hash_value];
+ z = SCM_SIMPLE_VECTOR_REF (method_cache, hash_value);
while (!scm_is_null (args))
{
/* More arguments than specifiers => CLASS != ENV */
@@ -5393,26 +5385,24 @@ check_map_args (SCM argv,
SCM args,
const char *who)
{
- SCM const *ve = SCM_VELTS (argv);
long i;
- for (i = SCM_VECTOR_LENGTH (argv) - 1; i >= 1; i--)
+ for (i = SCM_SIMPLE_VECTOR_LENGTH (argv) - 1; i >= 1; i--)
{
- long elt_len = scm_ilength (ve[i]);
+ SCM elt = SCM_SIMPLE_VECTOR_REF (argv, i);
+ long elt_len = scm_ilength (elt);
if (elt_len < 0)
{
if (gf)
scm_apply_generic (gf, scm_cons (proc, args));
else
- scm_wrong_type_arg (who, i + 2, ve[i]);
+ scm_wrong_type_arg (who, i + 2, elt);
}
if (elt_len != len)
- scm_out_of_range_pos (who, ve[i], scm_from_long (i + 2));
+ scm_out_of_range_pos (who, elt, scm_from_long (i + 2));
}
-
- scm_remember_upto_here_1 (argv);
}
@@ -5432,7 +5422,6 @@ scm_map (SCM proc, SCM arg1, SCM args)
long i, len;
SCM res = SCM_EOL;
SCM *pres = &res;
- SCM const *ve = &args; /* Keep args from being optimized away. */
len = scm_ilength (arg1);
SCM_GASSERTn (len >= 0,
@@ -5472,17 +5461,17 @@ scm_map (SCM proc, SCM arg1, SCM args)
}
arg1 = scm_cons (arg1, args);
args = scm_vector (arg1);
- ve = SCM_VELTS (args);
check_map_args (args, len, g_map, proc, arg1, s_map);
while (1)
{
arg1 = SCM_EOL;
- for (i = SCM_VECTOR_LENGTH (args) - 1; i >= 0; i--)
+ for (i = SCM_SIMPLE_VECTOR_LENGTH (args) - 1; i >= 0; i--)
{
- if (SCM_IMP (ve[i]))
+ SCM elt = SCM_SIMPLE_VECTOR_REF (args, i);
+ if (SCM_IMP (elt))
return res;
- arg1 = scm_cons (SCM_CAR (ve[i]), arg1);
- SCM_VECTOR_SET (args, i, SCM_CDR (ve[i]));
+ arg1 = scm_cons (SCM_CAR (elt), arg1);
+ SCM_SIMPLE_VECTOR_SET (args, i, SCM_CDR (elt));
}
*pres = scm_list_1 (scm_apply (proc, arg1, SCM_EOL));
pres = SCM_CDRLOC (*pres);
@@ -5497,7 +5486,6 @@ SCM
scm_for_each (SCM proc, SCM arg1, SCM args)
#define FUNC_NAME s_for_each
{
- SCM const *ve = &args; /* Keep args from being optimized away. */
long i, len;
len = scm_ilength (arg1);
SCM_GASSERTn (len >= 0, g_for_each, scm_cons2 (proc, arg1, args),
@@ -5535,17 +5523,17 @@ scm_for_each (SCM proc, SCM arg1, SCM args)
}
arg1 = scm_cons (arg1, args);
args = scm_vector (arg1);
- ve = SCM_VELTS (args);
check_map_args (args, len, g_for_each, proc, arg1, s_for_each);
while (1)
{
arg1 = SCM_EOL;
- for (i = SCM_VECTOR_LENGTH (args) - 1; i >= 0; i--)
+ for (i = SCM_SIMPLE_VECTOR_LENGTH (args) - 1; i >= 0; i--)
{
- if (SCM_IMP (ve[i]))
+ SCM elt = SCM_SIMPLE_VECTOR_REF (args, i);
+ if (SCM_IMP (elt))
return SCM_UNSPECIFIED;
- arg1 = scm_cons (SCM_CAR (ve[i]), arg1);
- SCM_VECTOR_SET (args, i, SCM_CDR (ve[i]));
+ arg1 = scm_cons (SCM_CAR (elt), arg1);
+ SCM_SIMPLE_VECTOR_SET (args, i, SCM_CDR (elt));
}
scm_apply (proc, arg1, SCM_EOL);
}
@@ -5683,7 +5671,7 @@ copy_tree (
struct t_trace *tortoise,
unsigned int tortoise_delay )
{
- if (!scm_is_pair (hare->obj) && !SCM_VECTORP (hare->obj))
+ if (!scm_is_pair (hare->obj) && !scm_is_simple_vector (hare->obj))
{
return hare->obj;
}
@@ -5711,10 +5699,10 @@ copy_tree (
--tortoise_delay;
}
- if (SCM_VECTORP (hare->obj))
+ if (scm_is_simple_vector (hare->obj))
{
- const unsigned long int length = SCM_VECTOR_LENGTH (hare->obj);
- const SCM new_vector = scm_c_make_vector (length, SCM_UNSPECIFIED);
+ size_t length = SCM_SIMPLE_VECTOR_LENGTH (hare->obj);
+ SCM new_vector = scm_c_make_vector (length, SCM_UNSPECIFIED);
/* Each vector element is copied by recursing into copy_tree, having
* the tortoise follow the hare into the depths of the stack. */
@@ -5722,9 +5710,9 @@ copy_tree (
for (i = 0; i < length; ++i)
{
SCM new_element;
- new_hare.obj = SCM_VECTOR_REF (hare->obj, i);
+ new_hare.obj = SCM_SIMPLE_VECTOR_REF (hare->obj, i);
new_element = copy_tree (&new_hare, tortoise, tortoise_delay);
- SCM_VECTOR_SET (new_vector, i, new_element);
+ SCM_SIMPLE_VECTOR_SET (new_vector, i, new_element);
}
return new_vector;
diff --git a/libguile/filesys.c b/libguile/filesys.c
index 9e01901f5..0d7cb25dc 100644
--- a/libguile/filesys.c
+++ b/libguile/filesys.c
@@ -453,56 +453,56 @@ scm_stat2scm (struct stat *stat_temp)
{
SCM ans = scm_c_make_vector (15, SCM_UNSPECIFIED);
- SCM_VECTOR_SET(ans, 0, scm_from_ulong (stat_temp->st_dev));
- SCM_VECTOR_SET(ans, 1, scm_from_ulong (stat_temp->st_ino));
- SCM_VECTOR_SET(ans, 2, scm_from_ulong (stat_temp->st_mode));
- SCM_VECTOR_SET(ans, 3, scm_from_ulong (stat_temp->st_nlink));
- SCM_VECTOR_SET(ans, 4, scm_from_ulong (stat_temp->st_uid));
- SCM_VECTOR_SET(ans, 5, scm_from_ulong (stat_temp->st_gid));
+ SCM_SIMPLE_VECTOR_SET(ans, 0, scm_from_ulong (stat_temp->st_dev));
+ SCM_SIMPLE_VECTOR_SET(ans, 1, scm_from_ulong (stat_temp->st_ino));
+ SCM_SIMPLE_VECTOR_SET(ans, 2, scm_from_ulong (stat_temp->st_mode));
+ SCM_SIMPLE_VECTOR_SET(ans, 3, scm_from_ulong (stat_temp->st_nlink));
+ SCM_SIMPLE_VECTOR_SET(ans, 4, scm_from_ulong (stat_temp->st_uid));
+ SCM_SIMPLE_VECTOR_SET(ans, 5, scm_from_ulong (stat_temp->st_gid));
#ifdef HAVE_STRUCT_STAT_ST_RDEV
- SCM_VECTOR_SET(ans, 6, scm_from_ulong (stat_temp->st_rdev));
+ SCM_SIMPLE_VECTOR_SET(ans, 6, scm_from_ulong (stat_temp->st_rdev));
#else
- SCM_VECTOR_SET(ans, 6, SCM_BOOL_F);
+ SCM_SIMPLE_VECTOR_SET(ans, 6, SCM_BOOL_F);
#endif
- SCM_VECTOR_SET(ans, 7, scm_from_ulong (stat_temp->st_size));
- SCM_VECTOR_SET(ans, 8, scm_from_ulong (stat_temp->st_atime));
- SCM_VECTOR_SET(ans, 9, scm_from_ulong (stat_temp->st_mtime));
- SCM_VECTOR_SET(ans, 10, scm_from_ulong (stat_temp->st_ctime));
+ SCM_SIMPLE_VECTOR_SET(ans, 7, scm_from_ulong (stat_temp->st_size));
+ SCM_SIMPLE_VECTOR_SET(ans, 8, scm_from_ulong (stat_temp->st_atime));
+ SCM_SIMPLE_VECTOR_SET(ans, 9, scm_from_ulong (stat_temp->st_mtime));
+ SCM_SIMPLE_VECTOR_SET(ans, 10, scm_from_ulong (stat_temp->st_ctime));
#ifdef HAVE_STRUCT_STAT_ST_BLKSIZE
- SCM_VECTOR_SET(ans, 11, scm_from_ulong (stat_temp->st_blksize));
+ SCM_SIMPLE_VECTOR_SET(ans, 11, scm_from_ulong (stat_temp->st_blksize));
#else
- SCM_VECTOR_SET(ans, 11, scm_from_ulong (4096L));
+ SCM_SIMPLE_VECTOR_SET(ans, 11, scm_from_ulong (4096L));
#endif
#ifdef HAVE_STRUCT_STAT_ST_BLOCKS
- SCM_VECTOR_SET(ans, 12, scm_from_ulong (stat_temp->st_blocks));
+ SCM_SIMPLE_VECTOR_SET(ans, 12, scm_from_ulong (stat_temp->st_blocks));
#else
- SCM_VECTOR_SET(ans, 12, SCM_BOOL_F);
+ SCM_SIMPLE_VECTOR_SET(ans, 12, SCM_BOOL_F);
#endif
{
int mode = stat_temp->st_mode;
if (S_ISREG (mode))
- SCM_VECTOR_SET(ans, 13, scm_sym_regular);
+ SCM_SIMPLE_VECTOR_SET(ans, 13, scm_sym_regular);
else if (S_ISDIR (mode))
- SCM_VECTOR_SET(ans, 13, scm_sym_directory);
+ SCM_SIMPLE_VECTOR_SET(ans, 13, scm_sym_directory);
#ifdef HAVE_S_ISLNK
else if (S_ISLNK (mode))
- SCM_VECTOR_SET(ans, 13, scm_sym_symlink);
+ SCM_SIMPLE_VECTOR_SET(ans, 13, scm_sym_symlink);
#endif
else if (S_ISBLK (mode))
- SCM_VECTOR_SET(ans, 13, scm_sym_block_special);
+ SCM_SIMPLE_VECTOR_SET(ans, 13, scm_sym_block_special);
else if (S_ISCHR (mode))
- SCM_VECTOR_SET(ans, 13, scm_sym_char_special);
+ SCM_SIMPLE_VECTOR_SET(ans, 13, scm_sym_char_special);
else if (S_ISFIFO (mode))
- SCM_VECTOR_SET(ans, 13, scm_sym_fifo);
+ SCM_SIMPLE_VECTOR_SET(ans, 13, scm_sym_fifo);
#ifdef S_ISSOCK
else if (S_ISSOCK (mode))
- SCM_VECTOR_SET(ans, 13, scm_sym_sock);
+ SCM_SIMPLE_VECTOR_SET(ans, 13, scm_sym_sock);
#endif
else
- SCM_VECTOR_SET(ans, 13, scm_sym_unknown);
+ SCM_SIMPLE_VECTOR_SET(ans, 13, scm_sym_unknown);
- SCM_VECTOR_SET(ans, 14, scm_from_int ((~S_IFMT) & mode));
+ SCM_SIMPLE_VECTOR_SET(ans, 14, scm_from_int ((~S_IFMT) & mode));
/* the layout of the bits in ve[14] is intended to be portable.
If there are systems that don't follow the usual convention,
@@ -531,7 +531,7 @@ scm_stat2scm (struct stat *stat_temp)
tmp <<= 1;
if (S_IXOTH & mode) tmp += 1;
- SCM_VECTOR_SET(ans, 14, scm_from_int (tmp));
+ SCM_SIMPLE_VECTOR_SET(ans, 14, scm_from_int (tmp));
*/
}
@@ -1048,14 +1048,14 @@ fill_select_type (SELECT_TYPE *set, SCM *ports_ready, SCM list_or_vec, int pos)
{
int max_fd = 0;
- if (SCM_VECTORP (list_or_vec))
+ if (scm_is_simple_vector (list_or_vec))
{
- int i = SCM_VECTOR_LENGTH (list_or_vec);
- SCM const *ve = SCM_VELTS (list_or_vec);
+ int i = SCM_SIMPLE_VECTOR_LENGTH (list_or_vec);
while (--i >= 0)
{
- int fd = set_element (set, ports_ready, ve[i], pos);
+ int fd = set_element (set, ports_ready,
+ SCM_SIMPLE_VECTOR_REF (list_or_vec, i), pos);
if (fd > max_fd)
max_fd = fd;
@@ -1109,14 +1109,15 @@ retrieve_select_type (SELECT_TYPE *set, SCM ports_ready, SCM list_or_vec)
{
SCM answer_list = ports_ready;
- if (SCM_VECTORP (list_or_vec))
+ if (scm_is_simple_vector (list_or_vec))
{
- int i = SCM_VECTOR_LENGTH (list_or_vec);
- SCM const *ve = SCM_VELTS (list_or_vec);
+ int i = SCM_SIMPLE_VECTOR_LENGTH (list_or_vec);
while (--i >= 0)
{
- answer_list = get_element (set, ve[i], answer_list);
+ answer_list = get_element (set,
+ SCM_SIMPLE_VECTOR_REF (list_or_vec, i),
+ answer_list);
}
return scm_vector (answer_list);
}
@@ -1177,27 +1178,27 @@ SCM_DEFINE (scm_select, "select", 3, 2, 0,
SCM write_ports_ready = SCM_EOL;
int max_fd;
- if (SCM_VECTORP (reads))
+ if (scm_is_simple_vector (reads))
{
- read_count = SCM_VECTOR_LENGTH (reads);
+ read_count = SCM_SIMPLE_VECTOR_LENGTH (reads);
}
else
{
read_count = scm_ilength (reads);
SCM_ASSERT (read_count >= 0, reads, SCM_ARG1, FUNC_NAME);
}
- if (SCM_VECTORP (writes))
+ if (scm_is_simple_vector (writes))
{
- write_count = SCM_VECTOR_LENGTH (writes);
+ write_count = SCM_SIMPLE_VECTOR_LENGTH (writes);
}
else
{
write_count = scm_ilength (writes);
SCM_ASSERT (write_count >= 0, writes, SCM_ARG2, FUNC_NAME);
}
- if (SCM_VECTORP (excepts))
+ if (scm_is_simple_vector (excepts))
{
- except_count = SCM_VECTOR_LENGTH (excepts);
+ except_count = SCM_SIMPLE_VECTOR_LENGTH (excepts);
}
else
{
diff --git a/libguile/fluids.c b/libguile/fluids.c
index da4b317e0..acdec1103 100644
--- a/libguile/fluids.c
+++ b/libguile/fluids.c
@@ -47,17 +47,18 @@ grow_fluids (scm_root_state *root_state, int new_length)
long old_length, i;
old_fluids = root_state->fluids;
- old_length = SCM_VECTOR_LENGTH (old_fluids);
+ old_length = SCM_SIMPLE_VECTOR_LENGTH (old_fluids);
new_fluids = scm_c_make_vector (new_length, SCM_BOOL_F);
i = 0;
while (i < old_length)
{
- SCM_VECTOR_SET (new_fluids, i, SCM_VELTS(old_fluids)[i]);
+ SCM_SIMPLE_VECTOR_SET (new_fluids, i,
+ SCM_SIMPLE_VECTOR_REF (old_fluids, i));
i++;
}
while (i < new_length)
{
- SCM_VECTOR_SET (new_fluids, i, SCM_BOOL_F);
+ SCM_SIMPLE_VECTOR_SET (new_fluids, i, SCM_BOOL_F);
i++;
}
@@ -67,7 +68,7 @@ grow_fluids (scm_root_state *root_state, int new_length)
void
scm_i_copy_fluids (scm_root_state *root_state)
{
- grow_fluids (root_state, SCM_VECTOR_LENGTH (root_state->fluids));
+ grow_fluids (root_state, SCM_SIMPLE_VECTOR_LENGTH (root_state->fluids));
}
static int
@@ -129,9 +130,9 @@ SCM_DEFINE (scm_fluid_ref, "fluid-ref", 1, 0, 0,
SCM_VALIDATE_FLUID (1, fluid);
n = SCM_FLUID_NUM (fluid);
- if (SCM_VECTOR_LENGTH (scm_root->fluids) <= n)
+ if (SCM_SIMPLE_VECTOR_LENGTH (scm_root->fluids) <= n)
grow_fluids (scm_root, n+1);
- return SCM_VELTS (scm_root->fluids)[n];
+ return SCM_SIMPLE_VECTOR_REF (scm_root->fluids, n);
}
#undef FUNC_NAME
@@ -145,9 +146,9 @@ SCM_DEFINE (scm_fluid_set_x, "fluid-set!", 2, 0, 0,
SCM_VALIDATE_FLUID (1, fluid);
n = SCM_FLUID_NUM (fluid);
- if (SCM_VECTOR_LENGTH (scm_root->fluids) <= n)
+ if (SCM_SIMPLE_VECTOR_LENGTH (scm_root->fluids) <= n)
grow_fluids (scm_root, n+1);
- SCM_VECTOR_SET (scm_root->fluids, n, value);
+ SCM_SIMPLE_VECTOR_SET (scm_root->fluids, n, value);
return SCM_UNSPECIFIED;
}
#undef FUNC_NAME
diff --git a/libguile/gc-mark.c b/libguile/gc-mark.c
index 89501e6eb..95ac82088 100644
--- a/libguile/gc-mark.c
+++ b/libguile/gc-mark.c
@@ -86,7 +86,7 @@ scm_mark_all (void)
size_t i;
for (i = 0; i < SCM_HASHTABLE_N_BUCKETS (scm_gc_registered_roots); ++i)
{
- SCM l = SCM_HASHTABLE_BUCKETS (scm_gc_registered_roots)[i];
+ SCM l = SCM_HASHTABLE_BUCKET (scm_gc_registered_roots, i);
for (; !scm_is_null (l); l = SCM_CDR (l))
{
SCM *p = (SCM *) (scm_to_ulong (SCM_CAAR (l)));
@@ -223,15 +223,16 @@ scm_gc_mark_dependencies (SCM p)
ptr = SCM_ENV (ptr);
goto gc_mark_nimp;
case scm_tc7_vector:
- i = SCM_VECTOR_LENGTH (ptr);
+ i = SCM_SIMPLE_VECTOR_LENGTH (ptr);
if (i == 0)
break;
while (--i > 0)
{
- if (SCM_NIMP (SCM_VELTS (ptr)[i]))
- scm_gc_mark (SCM_VELTS (ptr)[i]);
+ SCM elt = SCM_SIMPLE_VECTOR_REF (ptr, i);
+ if (SCM_NIMP (elt))
+ scm_gc_mark (elt);
}
- ptr = SCM_VELTS (ptr)[0];
+ ptr = SCM_SIMPLE_VECTOR_REF (ptr, 0);
goto gc_mark_loop;
#ifdef CCLO
case scm_tc7_cclo:
@@ -266,7 +267,7 @@ scm_gc_mark_dependencies (SCM p)
break;
case scm_tc7_wvect:
- SCM_SET_WVECT_GC_CHAIN (ptr, scm_weak_vectors);
+ SCM_I_SET_WVECT_GC_CHAIN (ptr, scm_weak_vectors);
scm_weak_vectors = ptr;
if (SCM_IS_WHVEC_ANY (ptr))
{
@@ -275,14 +276,14 @@ scm_gc_mark_dependencies (SCM p)
int weak_keys;
int weak_values;
- len = SCM_VECTOR_LENGTH (ptr);
+ len = SCM_SIMPLE_VECTOR_LENGTH (ptr);
weak_keys = SCM_WVECT_WEAK_KEY_P (ptr);
weak_values = SCM_WVECT_WEAK_VALUE_P (ptr);
for (x = 0; x < len; ++x)
{
SCM alist;
- alist = SCM_VELTS (ptr)[x];
+ alist = SCM_SIMPLE_VECTOR_REF (ptr, x);
/* mark everything on the alist except the keys or
* values, according to weak_values and weak_keys. */
diff --git a/libguile/gh.h b/libguile/gh.h
index c9558d3db..dbb04b197 100644
--- a/libguile/gh.h
+++ b/libguile/gh.h
@@ -85,14 +85,12 @@ SCM_API void gh_set_substr(const char *src, SCM dst, long start, size_t len);
SCM_API SCM gh_symbol2scm(const char *symbol_str);
SCM_API SCM gh_ints2scm(const int *d, long n);
-#if SCM_HAVE_ARRAYS
SCM_API SCM gh_chars2byvect(const char *d, long n);
SCM_API SCM gh_shorts2svect(const short *d, long n);
SCM_API SCM gh_longs2ivect(const long *d, long n);
SCM_API SCM gh_ulongs2uvect(const unsigned long *d, long n);
SCM_API SCM gh_floats2fvect(const float *d, long n);
SCM_API SCM gh_doubles2dvect(const double *d, long n);
-#endif
SCM_API SCM gh_doubles2scm(const double *d, long n);
diff --git a/libguile/gh_data.c b/libguile/gh_data.c
index 357ec7d5b..859327cd7 100644
--- a/libguile/gh_data.c
+++ b/libguile/gh_data.c
@@ -106,7 +106,7 @@ gh_ints2scm (const int *d, long n)
long i;
SCM v = scm_c_make_vector (n, SCM_UNSPECIFIED);
for (i = 0; i < n; ++i)
- SCM_VECTOR_SET (v, i, scm_from_int (d[i]));
+ SCM_SIMPLE_VECTOR_SET (v, i, scm_from_int (d[i]));
return v;
}
@@ -118,7 +118,7 @@ gh_doubles2scm (const double *d, long n)
SCM v = scm_c_make_vector (n, SCM_UNSPECIFIED);
for(i = 0; i < n; i++)
- SCM_VECTOR_SET (v, i, scm_from_double (d[i]));
+ SCM_SIMPLE_VECTOR_SET (v, i, scm_from_double (d[i]));
return v;
}
@@ -224,10 +224,10 @@ gh_scm2chars (SCM obj, char *m)
{
case scm_tc7_vector:
case scm_tc7_wvect:
- n = SCM_VECTOR_LENGTH (obj);
+ n = SCM_SIMPLE_VECTOR_LENGTH (obj);
for (i = 0; i < n; ++i)
{
- val = SCM_VELTS (obj)[i];
+ val = SCM_SIMPLE_VECTOR_REF (obj, i);
if (SCM_I_INUMP (val))
{
v = SCM_I_INUM (val);
@@ -242,24 +242,29 @@ gh_scm2chars (SCM obj, char *m)
if (m == NULL)
return NULL;
for (i = 0; i < n; ++i)
- m[i] = SCM_I_INUM (SCM_VELTS (obj)[i]);
+ m[i] = SCM_I_INUM (SCM_SIMPLE_VECTOR_REF (obj, i));
break;
-#if SCM_HAVE_ARRAYS
case scm_tc7_smob:
if (scm_is_true (scm_s8vector_p (obj)))
{
- n = scm_to_long (scm_s8vector_length (obj));
+ scm_t_array_handle handle;
+ size_t len;
+ ssize_t inc;
+ const scm_t_int8 *elts;
+
+ elts = scm_s8vector_elements (obj, &handle, &len, &inc);
+ if (inc != 1)
+ scm_misc_error (NULL, "only contiguous vectors are supported: ~a",
+ scm_list_1 (obj));
if (m == 0)
- m = (char *) malloc (n * sizeof (char));
+ m = (char *) malloc (len);
if (m == NULL)
return NULL;
- memcpy (m, scm_s8vector_elements (obj), n * sizeof (char));
- scm_remember_upto_here_1 (obj);
+ memcpy (m, elts, len);
break;
}
else
goto wrong_type;
-#endif
case scm_tc7_string:
n = scm_i_string_length (obj);
if (m == 0)
@@ -278,13 +283,22 @@ gh_scm2chars (SCM obj, char *m)
static void *
scm2whatever (SCM obj, void *m, size_t size)
{
- size_t n = scm_c_uniform_vector_length (obj);
+ scm_t_array_handle handle;
+ size_t len;
+ ssize_t inc;
+ const void *elts;
+
+ elts = scm_uniform_vector_elements (obj, &handle, &len, &inc);
+
+ if (inc != 1)
+ scm_misc_error (NULL, "only contiguous vectors can be converted: ~a",
+ scm_list_1 (obj));
+
if (m == 0)
- m = malloc (n * sizeof (size));
+ m = malloc (len * sizeof (size));
if (m == NULL)
return NULL;
- memcpy (m, scm_uniform_vector_elements (obj), n * size);
- scm_uniform_vector_release_elements (obj);
+ memcpy (m, elts, len * size);
return m;
}
@@ -313,10 +327,10 @@ gh_scm2shorts (SCM obj, short *m)
{
case scm_tc7_vector:
case scm_tc7_wvect:
- n = SCM_VECTOR_LENGTH (obj);
+ n = SCM_SIMPLE_VECTOR_LENGTH (obj);
for (i = 0; i < n; ++i)
{
- val = SCM_VELTS (obj)[i];
+ val = SCM_SIMPLE_VECTOR_REF (obj, i);
if (SCM_I_INUMP (val))
{
v = SCM_I_INUM (val);
@@ -331,7 +345,7 @@ gh_scm2shorts (SCM obj, short *m)
if (m == NULL)
return NULL;
for (i = 0; i < n; ++i)
- m[i] = SCM_I_INUM (SCM_VELTS (obj)[i]);
+ m[i] = SCM_I_INUM (SCM_SIMPLE_VECTOR_REF (obj, i));
break;
default:
scm_wrong_type_arg (0, 0, obj);
@@ -356,10 +370,10 @@ gh_scm2longs (SCM obj, long *m)
{
case scm_tc7_vector:
case scm_tc7_wvect:
- n = SCM_VECTOR_LENGTH (obj);
+ n = SCM_SIMPLE_VECTOR_LENGTH (obj);
for (i = 0; i < n; ++i)
{
- val = SCM_VELTS (obj)[i];
+ val = SCM_SIMPLE_VECTOR_REF (obj, i);
if (!SCM_I_INUMP (val) && !SCM_BIGP (val))
scm_wrong_type_arg (0, 0, obj);
}
@@ -369,7 +383,7 @@ gh_scm2longs (SCM obj, long *m)
return NULL;
for (i = 0; i < n; ++i)
{
- val = SCM_VELTS (obj)[i];
+ val = SCM_SIMPLE_VECTOR_REF (obj, i);
m[i] = SCM_I_INUMP (val)
? SCM_I_INUM (val)
: scm_to_long (val);
@@ -400,10 +414,10 @@ gh_scm2floats (SCM obj, float *m)
{
case scm_tc7_vector:
case scm_tc7_wvect:
- n = SCM_VECTOR_LENGTH (obj);
+ n = SCM_SIMPLE_VECTOR_LENGTH (obj);
for (i = 0; i < n; ++i)
{
- val = SCM_VELTS (obj)[i];
+ val = SCM_SIMPLE_VECTOR_REF (obj, i);
if (!SCM_I_INUMP (val)
&& !(SCM_BIGP (val) || SCM_REALP (val)))
scm_wrong_type_arg (0, 0, val);
@@ -414,7 +428,7 @@ gh_scm2floats (SCM obj, float *m)
return NULL;
for (i = 0; i < n; ++i)
{
- val = SCM_VELTS (obj)[i];
+ val = SCM_SIMPLE_VECTOR_REF (obj, i);
if (SCM_I_INUMP (val))
m[i] = SCM_I_INUM (val);
else if (SCM_BIGP (val))
@@ -448,10 +462,10 @@ gh_scm2doubles (SCM obj, double *m)
{
case scm_tc7_vector:
case scm_tc7_wvect:
- n = SCM_VECTOR_LENGTH (obj);
+ n = SCM_SIMPLE_VECTOR_LENGTH (obj);
for (i = 0; i < n; ++i)
{
- val = SCM_VELTS (obj)[i];
+ val = SCM_SIMPLE_VECTOR_REF (obj, i);
if (!SCM_I_INUMP (val)
&& !(SCM_BIGP (val) || SCM_REALP (val)))
scm_wrong_type_arg (0, 0, val);
@@ -462,7 +476,7 @@ gh_scm2doubles (SCM obj, double *m)
return NULL;
for (i = 0; i < n; ++i)
{
- val = SCM_VELTS (obj)[i];
+ val = SCM_SIMPLE_VECTOR_REF (obj, i);
if (SCM_I_INUMP (val))
m[i] = SCM_I_INUM (val);
else if (SCM_BIGP (val))
@@ -570,10 +584,9 @@ gh_vector_ref (SCM vec, SCM pos)
unsigned long
gh_vector_length (SCM v)
{
- return (unsigned long) SCM_VECTOR_LENGTH (v);
+ return (unsigned long) scm_c_vector_length (v);
}
-#if SCM_HAVE_ARRAYS
/* uniform vector support */
/* returns the length as a C unsigned long integer */
@@ -595,7 +608,6 @@ gh_uniform_vector_ref (SCM v, SCM ilist)
/* sets an individual element in a uniform vector */
/* SCM */
/* gh_list_to_uniform_array ( */
-#endif
/* Data lookups between C and Scheme
diff --git a/libguile/goops.c b/libguile/goops.c
index a290aeff9..066ff3001 100644
--- a/libguile/goops.c
+++ b/libguile/goops.c
@@ -1836,7 +1836,7 @@ scm_i_vector2list (SCM l, long len)
SCM z = scm_c_make_vector (len, SCM_UNDEFINED);
for (j = 0; j < len; j++, l = SCM_CDR (l)) {
- SCM_VECTOR_SET (z, j, SCM_CAR (l));
+ SCM_SIMPLE_VECTOR_SET (z, j, SCM_CAR (l));
}
return z;
}
@@ -1848,6 +1848,7 @@ sort_applicable_methods (SCM method_list, long size, SCM const *targs)
SCM *v, vector = SCM_EOL;
SCM buffer[BUFFSIZE];
SCM save = method_list;
+ scm_t_array_handle handle;
/* For reasonably sized method_lists we can try to avoid all the
* consing and reorder the list in place...
@@ -1866,13 +1867,7 @@ sort_applicable_methods (SCM method_list, long size, SCM const *targs)
{
/* Too many elements in method_list to keep everything locally */
vector = scm_i_vector2list (save, size);
-
- /*
- This is a new vector. Don't worry about the write barrier.
- We're not allocating elements in this routine, so this should
- pose no problem.
- */
- v = SCM_WRITABLE_VELTS (vector);
+ v = scm_vector_writable_elements (vector, &handle, NULL, NULL);
}
/* Use a simple shell sort since it is generally faster than qsort on
@@ -1907,6 +1902,7 @@ sort_applicable_methods (SCM method_list, long size, SCM const *targs)
}
return save;
}
+
/* If we are here, that's that we did it the hard way... */
return scm_vector_to_list (vector);
}
@@ -1922,21 +1918,20 @@ scm_compute_applicable_methods (SCM gf, SCM args, long len, int find_method_p)
SCM const *types;
SCM *p;
SCM tmp = SCM_EOL;
+ scm_t_array_handle handle;
/* Build the list of arguments types */
- if (len >= BUFFSIZE) {
- tmp = scm_c_make_vector (len, SCM_UNDEFINED);
- /* NOTE: Using pointers to malloced memory won't work if we
- 1. have preemtive threading, and,
- 2. have a GC which moves objects. */
- types = p = SCM_WRITABLE_VELTS(tmp);
+ if (len >= BUFFSIZE)
+ {
+ tmp = scm_c_make_vector (len, SCM_UNDEFINED);
+ types = p = scm_vector_writable_elements (tmp, &handle, NULL, NULL);
/*
note that we don't have to work to reset the generation
count. TMP is a new vector anyway, and it is found
conservatively.
*/
- }
+ }
else
types = p = buffer;
@@ -1977,7 +1972,6 @@ scm_compute_applicable_methods (SCM gf, SCM args, long len, int find_method_p)
return SCM_BOOL_F;
}
- scm_remember_upto_here_1 (tmp);
return (count == 1
? applicable
: sort_applicable_methods (applicable, count, types));
@@ -2178,21 +2172,34 @@ SCM_DEFINE (scm_sys_method_more_specific_p, "%method-more-specific?", 3, 0, 0,
"")
#define FUNC_NAME s_scm_sys_method_more_specific_p
{
- SCM l, v;
+ SCM l, v, result;
+ SCM *v_elts;
long i, len;
+ scm_t_array_handle handle;
SCM_VALIDATE_METHOD (1, m1);
SCM_VALIDATE_METHOD (2, m2);
SCM_ASSERT ((len = scm_ilength (targs)) != -1, targs, SCM_ARG3, FUNC_NAME);
- /* Verify that all the arguments of targs are classes and place them in a vector*/
+ /* Verify that all the arguments of targs are classes and place them
+ in a vector
+ */
+
v = scm_c_make_vector (len, SCM_EOL);
+ v_elts = scm_vector_writable_elements (v, &handle, NULL, NULL);
- for (i = 0, l = targs; !scm_is_null (l); i++, l = SCM_CDR (l)) {
- SCM_ASSERT (SCM_CLASSP (SCM_CAR (l)), targs, SCM_ARG3, FUNC_NAME);
- SCM_VECTOR_SET (v, i, SCM_CAR(l));
- }
- return more_specificp (m1, m2, SCM_VELTS(v)) ? SCM_BOOL_T: SCM_BOOL_F;
+ for (i = 0, l = targs; !scm_is_null (l); i++, l = SCM_CDR (l))
+ {
+ SCM_ASSERT (SCM_CLASSP (SCM_CAR (l)), targs, SCM_ARG3, FUNC_NAME);
+ v_elts[i] = SCM_CAR(l);
+ }
+
+ /* V_ELTS is only protected as long as HANDLE is, so we need to make
+ sure that more_specificp is not tail-called.
+ */
+ result = more_specificp (m1, m2, v_elts) ? SCM_BOOL_T: SCM_BOOL_F;
+ scm_remember_upto_here_1 (v);
+ return result;
}
#undef FUNC_NAME
diff --git a/libguile/hash.c b/libguile/hash.c
index 5123c2c15..9036d06db 100644
--- a/libguile/hash.c
+++ b/libguile/hash.c
@@ -120,20 +120,27 @@ scm_hasher(SCM obj, unsigned long n, size_t d)
case scm_tc7_wvect:
case scm_tc7_vector:
{
- size_t len = SCM_VECTOR_LENGTH(obj);
- SCM const *data = SCM_VELTS(obj);
+ size_t len = SCM_SIMPLE_VECTOR_LENGTH (obj);
if (len > 5)
{
size_t i = d/2;
unsigned long h = 1;
- while (i--) h = ((h << 8) + (scm_hasher (data[h % len], n, 2))) % n;
+ while (i--)
+ {
+ SCM elt = SCM_SIMPLE_VECTOR_REF (obj, h % len);
+ h = ((h << 8) + (scm_hasher (elt, n, 2))) % n;
+ }
return h;
}
else
{
size_t i = len;
unsigned long h = (n)-1;
- while (i--) h = ((h << 8) + (scm_hasher (data[i], n, d/len))) % n;
+ while (i--)
+ {
+ SCM elt = SCM_SIMPLE_VECTOR_REF (obj, h % len);
+ h = ((h << 8) + (scm_hasher (elt, n, d/len))) % n;
+ }
return h;
}
}
diff --git a/libguile/init.c b/libguile/init.c
index e991987ce..ca964afb3 100644
--- a/libguile/init.c
+++ b/libguile/init.c
@@ -529,10 +529,8 @@ scm_init_guile_1 (SCM_STACKITEM *base)
scm_init_evalext ();
scm_init_debug (); /* Requires macro smobs */
scm_init_random ();
-#if SCM_HAVE_ARRAYS
scm_init_ramap ();
scm_init_unif ();
-#endif
scm_init_simpos ();
scm_init_load_path ();
scm_init_standard_ports (); /* Requires fports */
diff --git a/libguile/modules.c b/libguile/modules.c
index 9bc0428c5..f0bdcc51e 100644
--- a/libguile/modules.c
+++ b/libguile/modules.c
@@ -577,7 +577,7 @@ scm_module_reverse_lookup (SCM module, SCM variable)
n = SCM_HASHTABLE_N_BUCKETS (obarray);
for (i = 0; i < n; ++i)
{
- SCM ls = SCM_HASHTABLE_BUCKETS (obarray)[i], handle;
+ SCM ls = SCM_HASHTABLE_BUCKET (obarray, i), handle;
while (!scm_is_null (ls))
{
handle = SCM_CAR (ls);
diff --git a/libguile/net_db.c b/libguile/net_db.c
index 8b2562d4a..cf353c82e 100644
--- a/libguile/net_db.c
+++ b/libguile/net_db.c
@@ -174,13 +174,13 @@ SCM_DEFINE (scm_gethost, "gethost", 0, 1, 0,
if (!entry)
scm_resolv_error (FUNC_NAME, host);
- SCM_VECTOR_SET(result, 0, scm_from_locale_string (entry->h_name));
- SCM_VECTOR_SET(result, 1, scm_makfromstrs (-1, entry->h_aliases));
- SCM_VECTOR_SET(result, 2, scm_from_int (entry->h_addrtype));
- SCM_VECTOR_SET(result, 3, scm_from_int (entry->h_length));
+ SCM_SIMPLE_VECTOR_SET(result, 0, scm_from_locale_string (entry->h_name));
+ SCM_SIMPLE_VECTOR_SET(result, 1, scm_makfromstrs (-1, entry->h_aliases));
+ SCM_SIMPLE_VECTOR_SET(result, 2, scm_from_int (entry->h_addrtype));
+ SCM_SIMPLE_VECTOR_SET(result, 3, scm_from_int (entry->h_length));
if (sizeof (struct in_addr) != entry->h_length)
{
- SCM_VECTOR_SET(result, 4, SCM_BOOL_F);
+ SCM_SIMPLE_VECTOR_SET(result, 4, SCM_BOOL_F);
return result;
}
for (argv = entry->h_addr_list; argv[i]; i++);
@@ -189,7 +189,7 @@ SCM_DEFINE (scm_gethost, "gethost", 0, 1, 0,
inad = *(struct in_addr *) argv[i];
lst = scm_cons (scm_from_ulong (ntohl (inad.s_addr)), lst);
}
- SCM_VECTOR_SET(result, 4, lst);
+ SCM_SIMPLE_VECTOR_SET(result, 4, lst);
return result;
}
#undef FUNC_NAME
@@ -248,10 +248,10 @@ SCM_DEFINE (scm_getnet, "getnet", 0, 1, 0,
if (!entry)
SCM_SYSERROR_MSG ("no such network ~A", scm_list_1 (net), eno);
- SCM_VECTOR_SET(result, 0, scm_from_locale_string (entry->n_name));
- SCM_VECTOR_SET(result, 1, scm_makfromstrs (-1, entry->n_aliases));
- SCM_VECTOR_SET(result, 2, scm_from_int (entry->n_addrtype));
- SCM_VECTOR_SET(result, 3, scm_from_ulong (entry->n_net));
+ SCM_SIMPLE_VECTOR_SET(result, 0, scm_from_locale_string (entry->n_name));
+ SCM_SIMPLE_VECTOR_SET(result, 1, scm_makfromstrs (-1, entry->n_aliases));
+ SCM_SIMPLE_VECTOR_SET(result, 2, scm_from_int (entry->n_addrtype));
+ SCM_SIMPLE_VECTOR_SET(result, 3, scm_from_ulong (entry->n_net));
return result;
}
#undef FUNC_NAME
@@ -300,9 +300,9 @@ SCM_DEFINE (scm_getproto, "getproto", 0, 1, 0,
if (!entry)
SCM_SYSERROR_MSG ("no such protocol ~A", scm_list_1 (protocol), eno);
- SCM_VECTOR_SET(result, 0, scm_from_locale_string (entry->p_name));
- SCM_VECTOR_SET(result, 1, scm_makfromstrs (-1, entry->p_aliases));
- SCM_VECTOR_SET(result, 2, scm_from_int (entry->p_proto));
+ SCM_SIMPLE_VECTOR_SET(result, 0, scm_from_locale_string (entry->p_name));
+ SCM_SIMPLE_VECTOR_SET(result, 1, scm_makfromstrs (-1, entry->p_aliases));
+ SCM_SIMPLE_VECTOR_SET(result, 2, scm_from_int (entry->p_proto));
return result;
}
#undef FUNC_NAME
@@ -314,10 +314,10 @@ scm_return_entry (struct servent *entry)
{
SCM result = scm_c_make_vector (4, SCM_UNSPECIFIED);
- SCM_VECTOR_SET(result, 0, scm_from_locale_string (entry->s_name));
- SCM_VECTOR_SET(result, 1, scm_makfromstrs (-1, entry->s_aliases));
- SCM_VECTOR_SET(result, 2, scm_from_uint16 (ntohs (entry->s_port)));
- SCM_VECTOR_SET(result, 3, scm_from_locale_string (entry->s_proto));
+ SCM_SIMPLE_VECTOR_SET(result, 0, scm_from_locale_string (entry->s_name));
+ SCM_SIMPLE_VECTOR_SET(result, 1, scm_makfromstrs (-1, entry->s_aliases));
+ SCM_SIMPLE_VECTOR_SET(result, 2, scm_from_uint16 (ntohs (entry->s_port)));
+ SCM_SIMPLE_VECTOR_SET(result, 3, scm_from_locale_string (entry->s_proto));
return result;
}
diff --git a/libguile/objects.c b/libguile/objects.c
index 060ebb0b3..279340131 100644
--- a/libguile/objects.c
+++ b/libguile/objects.c
@@ -229,12 +229,12 @@ scm_mcache_lookup_cmethod (SCM cache, SCM args)
n = scm_to_ulong (SCM_CAR (z)); /* maximum number of specializers */
methods = SCM_CADR (z);
- if (SCM_VECTORP (methods))
+ if (scm_is_simple_vector (methods))
{
/* cache format #1: prepare for linear search */
mask = -1;
i = 0;
- end = SCM_VECTOR_LENGTH (methods);
+ end = SCM_SIMPLE_VECTOR_LENGTH (methods);
}
else
{
@@ -262,7 +262,7 @@ scm_mcache_lookup_cmethod (SCM cache, SCM args)
do
{
long j = n;
- z = SCM_VELTS (methods)[i];
+ z = SCM_SIMPLE_VECTOR_REF (methods, i);
ls = args; /* list of arguments */
if (!scm_is_null (ls))
do
diff --git a/libguile/ports.c b/libguile/ports.c
index d628f47bc..e06ab0fa4 100644
--- a/libguile/ports.c
+++ b/libguile/ports.c
@@ -818,17 +818,17 @@ scm_c_port_for_each (void (*proc)(void *data, SCM p), void *data)
n = scm_i_port_table_size;
scm_mutex_unlock (&scm_i_port_table_mutex);
- ports = scm_make_vector (scm_from_size_t (n), SCM_BOOL_F);
+ ports = scm_c_make_vector (n, SCM_BOOL_F);
scm_mutex_lock (&scm_i_port_table_mutex);
if (n > scm_i_port_table_size)
n = scm_i_port_table_size;
for (i = 0; i < n; i++)
- SCM_VECTOR_SET (ports, i, scm_i_port_table[i]->port);
+ SCM_SIMPLE_VECTOR_SET (ports, i, scm_i_port_table[i]->port);
scm_mutex_unlock (&scm_i_port_table_mutex);
for (i = 0; i < n; i++)
- proc (data, SCM_VECTOR_REF (ports, i));
+ proc (data, SCM_SIMPLE_VECTOR_REF (ports, i));
}
SCM_DEFINE (scm_port_for_each, "port-for-each", 1, 0, 0,
diff --git a/libguile/posix.c b/libguile/posix.c
index 0ffd85b2d..8fa5cd959 100644
--- a/libguile/posix.c
+++ b/libguile/posix.c
@@ -268,7 +268,7 @@ SCM_DEFINE (scm_getgroups, "getgroups", 0, 0, 0,
result = scm_c_make_vector (ngroups, SCM_BOOL_F);
while (--ngroups >= 0)
- SCM_VECTOR_SET (result, ngroups, scm_from_ulong (groups[ngroups]));
+ SCM_SIMPLE_VECTOR_SET (result, ngroups, scm_from_ulong (groups[ngroups]));
free (groups);
return result;
@@ -295,17 +295,18 @@ SCM_DEFINE (scm_setgroups, "setgroups", 1, 0, 0,
SCM_VALIDATE_VECTOR (SCM_ARG1, group_vec);
- ngroups = SCM_VECTOR_LENGTH (group_vec);
+ ngroups = SCM_SIMPLE_VECTOR_LENGTH (group_vec);
/* validate before allocating, so we don't have to worry about leaks */
for (i = 0; i < ngroups; i++)
{
unsigned long ulong_gid;
GETGROUPS_T gid;
- SCM_VALIDATE_ULONG_COPY (1, SCM_VECTOR_REF (group_vec, i), ulong_gid);
+ SCM_VALIDATE_ULONG_COPY (1, SCM_SIMPLE_VECTOR_REF (group_vec, i),
+ ulong_gid);
gid = ulong_gid;
if (gid != ulong_gid)
- SCM_OUT_OF_RANGE (1, SCM_VECTOR_REF (group_vec, i));
+ SCM_OUT_OF_RANGE (1, SCM_SIMPLE_VECTOR_REF (group_vec, i));
}
size = ngroups * sizeof (GETGROUPS_T);
@@ -313,7 +314,7 @@ SCM_DEFINE (scm_setgroups, "setgroups", 1, 0, 0,
SCM_OUT_OF_RANGE (SCM_ARG1, scm_from_int (ngroups));
groups = scm_malloc (size);
for(i = 0; i < ngroups; i++)
- groups [i] = SCM_NUM2ULONG (1, SCM_VECTOR_REF (group_vec, i));
+ groups [i] = SCM_NUM2ULONG (1, SCM_SIMPLE_VECTOR_REF (group_vec, i));
result = setgroups (ngroups, groups);
save_errno = errno; /* don't let free() touch errno */
@@ -357,19 +358,19 @@ SCM_DEFINE (scm_getpwuid, "getpw", 0, 1, 0,
if (!entry)
SCM_MISC_ERROR ("entry not found", SCM_EOL);
- SCM_VECTOR_SET(result, 0, scm_from_locale_string (entry->pw_name));
- SCM_VECTOR_SET(result, 1, scm_from_locale_string (entry->pw_passwd));
- SCM_VECTOR_SET(result, 2, scm_from_ulong (entry->pw_uid));
- SCM_VECTOR_SET(result, 3, scm_from_ulong (entry->pw_gid));
- SCM_VECTOR_SET(result, 4, scm_from_locale_string (entry->pw_gecos));
+ SCM_SIMPLE_VECTOR_SET(result, 0, scm_from_locale_string (entry->pw_name));
+ SCM_SIMPLE_VECTOR_SET(result, 1, scm_from_locale_string (entry->pw_passwd));
+ SCM_SIMPLE_VECTOR_SET(result, 2, scm_from_ulong (entry->pw_uid));
+ SCM_SIMPLE_VECTOR_SET(result, 3, scm_from_ulong (entry->pw_gid));
+ SCM_SIMPLE_VECTOR_SET(result, 4, scm_from_locale_string (entry->pw_gecos));
if (!entry->pw_dir)
- SCM_VECTOR_SET(result, 5, scm_from_locale_string (""));
+ SCM_SIMPLE_VECTOR_SET(result, 5, scm_from_locale_string (""));
else
- SCM_VECTOR_SET(result, 5, scm_from_locale_string (entry->pw_dir));
+ SCM_SIMPLE_VECTOR_SET(result, 5, scm_from_locale_string (entry->pw_dir));
if (!entry->pw_shell)
- SCM_VECTOR_SET(result, 6, scm_from_locale_string (""));
+ SCM_SIMPLE_VECTOR_SET(result, 6, scm_from_locale_string (""));
else
- SCM_VECTOR_SET(result, 6, scm_from_locale_string (entry->pw_shell));
+ SCM_SIMPLE_VECTOR_SET(result, 6, scm_from_locale_string (entry->pw_shell));
return result;
}
#undef FUNC_NAME
@@ -422,10 +423,10 @@ SCM_DEFINE (scm_getgrgid, "getgr", 0, 1, 0,
if (!entry)
SCM_SYSERROR;
- SCM_VECTOR_SET(result, 0, scm_from_locale_string (entry->gr_name));
- SCM_VECTOR_SET(result, 1, scm_from_locale_string (entry->gr_passwd));
- SCM_VECTOR_SET(result, 2, scm_from_ulong (entry->gr_gid));
- SCM_VECTOR_SET(result, 3, scm_makfromstrs (-1, entry->gr_mem));
+ SCM_SIMPLE_VECTOR_SET(result, 0, scm_from_locale_string (entry->gr_name));
+ SCM_SIMPLE_VECTOR_SET(result, 1, scm_from_locale_string (entry->gr_passwd));
+ SCM_SIMPLE_VECTOR_SET(result, 2, scm_from_ulong (entry->gr_gid));
+ SCM_SIMPLE_VECTOR_SET(result, 3, scm_makfromstrs (-1, entry->gr_mem));
return result;
}
#undef FUNC_NAME
@@ -1053,14 +1054,14 @@ SCM_DEFINE (scm_uname, "uname", 0, 0, 0,
SCM result = scm_c_make_vector (5, SCM_UNSPECIFIED);
if (uname (&buf) < 0)
SCM_SYSERROR;
- SCM_VECTOR_SET(result, 0, scm_from_locale_string (buf.sysname));
- SCM_VECTOR_SET(result, 1, scm_from_locale_string (buf.nodename));
- SCM_VECTOR_SET(result, 2, scm_from_locale_string (buf.release));
- SCM_VECTOR_SET(result, 3, scm_from_locale_string (buf.version));
- SCM_VECTOR_SET(result, 4, scm_from_locale_string (buf.machine));
+ SCM_SIMPLE_VECTOR_SET(result, 0, scm_from_locale_string (buf.sysname));
+ SCM_SIMPLE_VECTOR_SET(result, 1, scm_from_locale_string (buf.nodename));
+ SCM_SIMPLE_VECTOR_SET(result, 2, scm_from_locale_string (buf.release));
+ SCM_SIMPLE_VECTOR_SET(result, 3, scm_from_locale_string (buf.version));
+ SCM_SIMPLE_VECTOR_SET(result, 4, scm_from_locale_string (buf.machine));
/*
a linux special?
- SCM_VECTOR_SET(result, 5, scm_from_locale_string (buf.domainname));
+ SCM_SIMPLE_VECTOR_SET(result, 5, scm_from_locale_string (buf.domainname));
*/
return result;
}
diff --git a/libguile/print.c b/libguile/print.c
index d8689111f..c7ef59fc1 100644
--- a/libguile/print.c
+++ b/libguile/print.c
@@ -162,8 +162,8 @@ make_print_state (void)
= scm_make_struct (scm_print_state_vtable, SCM_INUM0, SCM_EOL);
scm_print_state *pstate = SCM_PRINT_STATE (print_state);
pstate->ref_vect = scm_c_make_vector (PSTATE_SIZE, SCM_UNDEFINED);
- pstate->ref_stack = SCM_WRITABLE_VELTS (pstate->ref_vect);
- pstate->ceiling = SCM_VECTOR_LENGTH (pstate->ref_vect);
+ pstate->ref_stack = SCM_SIMPLE_VECTOR_LOC (pstate->ref_vect, 0);
+ pstate->ceiling = SCM_SIMPLE_VECTOR_LENGTH (pstate->ref_vect);
pstate->highlight_objects = SCM_EOL;
return print_state;
}
@@ -224,17 +224,17 @@ scm_i_port_with_print_state (SCM port, SCM print_state)
static void
grow_ref_stack (scm_print_state *pstate)
{
- unsigned long int old_size = SCM_VECTOR_LENGTH (pstate->ref_vect);
- SCM const *old_elts = SCM_VELTS (pstate->ref_vect);
- unsigned long int new_size = 2 * pstate->ceiling;
+ SCM old_vect = pstate->ref_vect;
+ size_t old_size = SCM_SIMPLE_VECTOR_LENGTH (old_vect);
+ size_t new_size = 2 * pstate->ceiling;
SCM new_vect = scm_c_make_vector (new_size, SCM_UNDEFINED);
unsigned long int i;
for (i = 0; i != old_size; ++i)
- SCM_VECTOR_SET (new_vect, i, old_elts [i]);
+ SCM_SIMPLE_VECTOR_SET (new_vect, i, SCM_SIMPLE_VECTOR_REF (old_vect, i));
pstate->ref_vect = new_vect;
- pstate->ref_stack = SCM_WRITABLE_VELTS(new_vect);
+ pstate->ref_stack = SCM_SIMPLE_VECTOR_LOC (new_vect, 0);
pstate->ceiling = new_size;
}
@@ -574,9 +574,10 @@ iprin1 (SCM exp, SCM port, scm_print_state *pstate)
common_vector_printer:
{
register long i;
- long last = SCM_VECTOR_LENGTH (exp) - 1;
+ long last = SCM_SIMPLE_VECTOR_LENGTH (exp) - 1;
int cutp = 0;
- if (pstate->fancyp && SCM_VECTOR_LENGTH (exp) > pstate->length)
+ if (pstate->fancyp
+ && SCM_SIMPLE_VECTOR_LENGTH (exp) > pstate->length)
{
last = pstate->length - 1;
cutp = 1;
@@ -584,13 +585,13 @@ iprin1 (SCM exp, SCM port, scm_print_state *pstate)
for (i = 0; i < last; ++i)
{
/* CHECK_INTS; */
- scm_iprin1 (SCM_VELTS (exp)[i], port, pstate);
+ scm_iprin1 (SCM_SIMPLE_VECTOR_REF (exp, i), port, pstate);
scm_putc (' ', port);
}
if (i == last)
{
/* CHECK_INTS; */
- scm_iprin1 (SCM_VELTS (exp)[i], port, pstate);
+ scm_iprin1 (SCM_SIMPLE_VECTOR_REF (exp, i), port, pstate);
}
if (cutp)
scm_puts (" ...", port);
diff --git a/libguile/random.c b/libguile/random.c
index 42a28097e..37d16fc1c 100644
--- a/libguile/random.c
+++ b/libguile/random.c
@@ -424,26 +424,28 @@ SCM_DEFINE (scm_random_normal, "random:normal", 0, 1, 0,
}
#undef FUNC_NAME
-#if SCM_HAVE_ARRAYS
-
static void
vector_scale_x (SCM v, double c)
{
size_t n;
- if (SCM_VECTORP (v))
+ if (scm_is_simple_vector (v))
{
- n = SCM_VECTOR_LENGTH (v);
+ n = SCM_SIMPLE_VECTOR_LENGTH (v);
while (n-- > 0)
- SCM_REAL_VALUE (SCM_VELTS (v)[n]) *= c;
+ SCM_REAL_VALUE (SCM_SIMPLE_VECTOR_REF (v, n)) *= c;
}
else
{
/* must be a f64vector. */
- double *elts = scm_f64vector_writable_elements (v);
- n = scm_c_uniform_vector_length (v);
- while (n-- > 0)
- elts[n] *= c;
- scm_uniform_vector_release_writable_elements (v);
+ scm_t_array_handle handle;
+ size_t i, len;
+ ssize_t inc;
+ double *elts;
+
+ elts = scm_f64vector_writable_elements (v, &handle, &len, &inc);
+
+ for (i = 0; i < len; i++, elts += inc)
+ *elts *= c;
}
}
@@ -452,26 +454,31 @@ vector_sum_squares (SCM v)
{
double x, sum = 0.0;
size_t n;
- if (SCM_VECTORP (v))
+ if (scm_is_simple_vector (v))
{
- n = SCM_VECTOR_LENGTH (v);
+ n = SCM_SIMPLE_VECTOR_LENGTH (v);
while (n-- > 0)
{
- x = SCM_REAL_VALUE (SCM_VELTS (v)[n]);
+ x = SCM_REAL_VALUE (SCM_SIMPLE_VECTOR_REF (v, n));
sum += x * x;
}
}
else
{
/* must be a f64vector. */
- const double *elts = scm_f64vector_elements (v);
- n = scm_c_uniform_vector_length (v);
- while (n-- > 0)
+ scm_t_array_handle handle;
+ size_t i, len;
+ ssize_t inc;
+ const double *elts;
+
+ elts = scm_f64vector_elements (v, &handle, &len, &inc);
+
+ for (i = 0; i < len; i++, elts += inc)
{
- x = elts[n];
+ x = *elts;
sum += x * x;
}
- scm_uniform_vector_release_elements (v);
+
}
return sum;
}
@@ -530,33 +537,35 @@ SCM_DEFINE (scm_random_normal_vector_x, "random:normal-vector!", 1, 1, 0,
"(i.e., with mean 0 and variance 1).")
#define FUNC_NAME s_scm_random_normal_vector_x
{
- size_t n;
+ long i;
+ scm_t_array_handle handle;
+ scm_t_array_dim *dim;
if (SCM_UNBNDP (state))
state = SCM_VARIABLE_REF (scm_var_random_state);
SCM_VALIDATE_RSTATE (2, state);
- if (SCM_VECTORP (v))
+
+ scm_vector_get_handle (v, &handle);
+ dim = scm_array_handle_dims (&handle);
+
+ if (scm_is_vector (v))
{
- n = SCM_VECTOR_LENGTH (v);
- while (n-- > 0)
- SCM_VECTOR_SET (v, n,
- scm_from_double (scm_c_normal01 (SCM_RSTATE (state))));
+ SCM *elts = scm_array_handle_writable_elements (&handle);
+ for (i = dim->lbnd; i <= dim->ubnd; i++, elts += dim->inc)
+ *elts = scm_from_double (scm_c_normal01 (SCM_RSTATE (state)));
}
else
{
/* must be a f64vector. */
- double *elts = scm_f64vector_writable_elements (v);
- n = scm_c_uniform_vector_length (v);
- while (n-- > 0)
- elts[n] = scm_c_normal01 (SCM_RSTATE (state));
- scm_uniform_vector_release_writable_elements (v);
+ double *elts = scm_array_handle_f64_writable_elements (&handle);
+ for (i = dim->lbnd; i <= dim->ubnd; i++, elts += dim->inc)
+ *elts = scm_c_normal01 (SCM_RSTATE (state));
}
+
return SCM_UNSPECIFIED;
}
#undef FUNC_NAME
-#endif /* SCM_HAVE_ARRAYS */
-
SCM_DEFINE (scm_random_exp, "random:exp", 0, 1, 0,
(SCM state),
"Return an inexact real in an exponential distribution with mean\n"
diff --git a/libguile/read.c b/libguile/read.c
index 187bd0d8a..f2913f915 100644
--- a/libguile/read.c
+++ b/libguile/read.c
@@ -482,7 +482,6 @@ scm_lreadr (SCM *tok_buf, SCM port, SCM *copy)
over in scm_flush_ws. */
abort ();
-#if SCM_HAVE_ARRAYS
case '*':
j = scm_read_token (c, tok_buf, port, 0);
p = scm_istr2bve (scm_c_substring_shared (*tok_buf, 1, j));
@@ -490,7 +489,6 @@ scm_lreadr (SCM *tok_buf, SCM port, SCM *copy)
return p;
else
goto unkshrp;
-#endif
case '{':
j = scm_read_token (c, tok_buf, port, 1);
diff --git a/libguile/regex-posix.c b/libguile/regex-posix.c
index 1e9333ba7..0c51280ed 100644
--- a/libguile/regex-posix.c
+++ b/libguile/regex-posix.c
@@ -256,13 +256,13 @@ SCM_DEFINE (scm_regexp_exec, "regexp-exec", 2, 2, 0,
/* The match vector must include a cell for the string that was matched,
so add 1. */
mvec = scm_c_make_vector (nmatches + 1, SCM_UNSPECIFIED);
- SCM_VECTOR_SET(mvec,0, str);
+ SCM_SIMPLE_VECTOR_SET(mvec,0, str);
for (i = 0; i < nmatches; ++i)
if (matches[i].rm_so == -1)
- SCM_VECTOR_SET(mvec, i+1,
+ SCM_SIMPLE_VECTOR_SET(mvec, i+1,
scm_cons (scm_from_int (-1), scm_from_int (-1)));
else
- SCM_VECTOR_SET(mvec, i+1,
+ SCM_SIMPLE_VECTOR_SET(mvec, i+1,
scm_cons (scm_from_long (matches[i].rm_so + offset),
scm_from_long (matches[i].rm_eo + offset)));
}
diff --git a/libguile/scmsigs.c b/libguile/scmsigs.c
index d57deabab..33afc8391 100644
--- a/libguile/scmsigs.c
+++ b/libguile/scmsigs.c
@@ -100,9 +100,9 @@ take_signal (int signum)
{
if (signum >= 0 && signum < NSIG)
{
- SCM cell = SCM_VECTOR_REF(signal_handler_cells, signum);
- SCM handler = SCM_VECTOR_REF(signal_cell_handlers, signum);
- SCM thread = SCM_VECTOR_REF(signal_handler_threads, signum);
+ SCM cell = SCM_SIMPLE_VECTOR_REF (signal_handler_cells, signum);
+ SCM handler = SCM_SIMPLE_VECTOR_REF (signal_cell_handlers, signum);
+ SCM thread = SCM_SIMPLE_VECTOR_REF (signal_handler_threads, signum);
scm_root_state *root = scm_i_thread_root (thread);
if (scm_is_pair (cell))
{
@@ -183,15 +183,15 @@ really_install_handler (void *data)
*/
/* Make sure we have a cell. */
- cell = SCM_VECTOR_REF (signal_handler_cells, signum);
+ cell = SCM_SIMPLE_VECTOR_REF (signal_handler_cells, signum);
if (scm_is_false (cell))
{
cell = scm_cons (SCM_BOOL_F, SCM_EOL);
- SCM_VECTOR_SET (signal_handler_cells, signum, cell);
+ SCM_SIMPLE_VECTOR_SET (signal_handler_cells, signum, cell);
}
/* Make sure it is queued for the right thread. */
- old_thread = SCM_VECTOR_REF (signal_handler_threads, signum);
+ old_thread = SCM_SIMPLE_VECTOR_REF (signal_handler_threads, signum);
if (!scm_is_eq (thread, old_thread))
{
scm_root_state *r;
@@ -210,20 +210,20 @@ really_install_handler (void *data)
pending_asyncs of old_thread. */
r->pending_asyncs = 1;
}
- SCM_VECTOR_SET (signal_handler_threads, signum, thread);
+ SCM_SIMPLE_VECTOR_SET (signal_handler_threads, signum, thread);
}
/* Set the new handler. */
if (scm_is_false (handler))
{
- SCM_VECTOR_SET (*signal_handlers, signum, SCM_BOOL_F);
- SCM_VECTOR_SET (signal_cell_handlers, signum, SCM_BOOL_F);
+ SCM_SIMPLE_VECTOR_SET (*signal_handlers, signum, SCM_BOOL_F);
+ SCM_SIMPLE_VECTOR_SET (signal_cell_handlers, signum, SCM_BOOL_F);
}
else
{
- SCM_VECTOR_SET (*signal_handlers, signum, handler);
- SCM_VECTOR_SET (signal_cell_handlers, signum,
- close_1 (handler, scm_from_int (signum)));
+ SCM_SIMPLE_VECTOR_SET (*signal_handlers, signum, handler);
+ SCM_SIMPLE_VECTOR_SET (signal_cell_handlers, signum,
+ close_1 (handler, scm_from_int (signum)));
}
/* Now fix up the cell. It might contain the old handler but since
@@ -233,7 +233,7 @@ really_install_handler (void *data)
problem.
*/
if (scm_is_true (SCM_CAR (cell)))
- SCM_SETCAR (cell, SCM_VECTOR_REF (signal_cell_handlers, signum));
+ SCM_SETCAR (cell, SCM_SIMPLE_VECTOR_REF (signal_cell_handlers, signum));
/* Phfew. That should be it. */
return NULL;
@@ -324,7 +324,7 @@ SCM_DEFINE (scm_sigaction_for_thread, "sigaction", 1, 3, 0,
}
SCM_DEFER_INTS;
- old_handler = SCM_VECTOR_REF(*signal_handlers, csig);
+ old_handler = SCM_SIMPLE_VECTOR_REF (*signal_handlers, csig);
if (SCM_UNBNDP (handler))
query_only = 1;
else if (scm_is_integer (handler))
@@ -465,7 +465,7 @@ SCM_DEFINE (scm_restore_signals, "restore-signals", 0, 0, 0,
if (sigaction (i, &orig_handlers[i], NULL) == -1)
SCM_SYSERROR;
orig_handlers[i].sa_handler = SIG_ERR;
- SCM_VECTOR_SET (*signal_handlers, i, SCM_BOOL_F);
+ SCM_SIMPLE_VECTOR_SET (*signal_handlers, i, SCM_BOOL_F);
}
#else
if (orig_handlers[i] != SIG_ERR)
@@ -473,7 +473,7 @@ SCM_DEFINE (scm_restore_signals, "restore-signals", 0, 0, 0,
if (signal (i, orig_handlers[i]) == SIG_ERR)
SCM_SYSERROR;
orig_handlers[i] = SIG_ERR;
- SCM_VECTOR_SET (*signal_handlers, i, SCM_BOOL_F);
+ SCM_SIMPLE_VECTOR_SET (*signal_handlers, i, SCM_BOOL_F);
}
#endif
}
diff --git a/libguile/socket.c b/libguile/socket.c
index 743309571..2429893fc 100644
--- a/libguile/socket.c
+++ b/libguile/socket.c
@@ -910,12 +910,12 @@ scm_addr_vector (const struct sockaddr *address, int addr_size,
result = scm_c_make_vector (3, SCM_UNSPECIFIED);
- SCM_VECTOR_SET(result, 0,
- scm_from_short (fam));
- SCM_VECTOR_SET(result, 1,
- scm_from_ulong (ntohl (nad->sin_addr.s_addr)));
- SCM_VECTOR_SET(result, 2,
- scm_from_ushort (ntohs (nad->sin_port)));
+ SCM_SIMPLE_VECTOR_SET(result, 0,
+ scm_from_short (fam));
+ SCM_SIMPLE_VECTOR_SET(result, 1,
+ scm_from_ulong (ntohl (nad->sin_addr.s_addr)));
+ SCM_SIMPLE_VECTOR_SET(result, 2,
+ scm_from_ushort (ntohs (nad->sin_port)));
}
break;
#ifdef HAVE_IPV6
@@ -924,14 +924,14 @@ scm_addr_vector (const struct sockaddr *address, int addr_size,
const struct sockaddr_in6 *nad = (struct sockaddr_in6 *) address;
result = scm_c_make_vector (5, SCM_UNSPECIFIED);
- SCM_VECTOR_SET(result, 0, scm_from_short (fam));
- SCM_VECTOR_SET(result, 1, scm_from_ipv6 (nad->sin6_addr.s6_addr));
- SCM_VECTOR_SET(result, 2, scm_from_ushort (ntohs (nad->sin6_port)));
- SCM_VECTOR_SET(result, 3, scm_from_uint32 (nad->sin6_flowinfo));
+ SCM_SIMPLE_VECTOR_SET(result, 0, scm_from_short (fam));
+ SCM_SIMPLE_VECTOR_SET(result, 1, scm_from_ipv6 (nad->sin6_addr.s6_addr));
+ SCM_SIMPLE_VECTOR_SET(result, 2, scm_from_ushort (ntohs (nad->sin6_port)));
+ SCM_SIMPLE_VECTOR_SET(result, 3, scm_from_uint32 (nad->sin6_flowinfo));
#ifdef HAVE_SIN6_SCOPE_ID
- SCM_VECTOR_SET(result, 4, scm_from_ulong (nad->sin6_scope_id));
+ SCM_SIMPLE_VECTOR_SET(result, 4, scm_from_ulong (nad->sin6_scope_id));
#else
- SCM_VECTOR_SET(result, 4, SCM_INUM0);
+ SCM_SIMPLE_VECTOR_SET(result, 4, SCM_INUM0);
#endif
}
break;
@@ -943,13 +943,13 @@ scm_addr_vector (const struct sockaddr *address, int addr_size,
result = scm_c_make_vector (2, SCM_UNSPECIFIED);
- SCM_VECTOR_SET(result, 0, scm_from_short (fam));
+ SCM_SIMPLE_VECTOR_SET(result, 0, scm_from_short (fam));
/* When addr_size is not enough to cover sun_path, do not try
to access it. */
if (addr_size <= offsetof (struct sockaddr_un, sun_path))
- SCM_VECTOR_SET(result, 1, SCM_BOOL_F);
+ SCM_SIMPLE_VECTOR_SET(result, 1, SCM_BOOL_F);
else
- SCM_VECTOR_SET(result, 1, scm_from_locale_string (nad->sun_path));
+ SCM_SIMPLE_VECTOR_SET(result, 1, scm_from_locale_string (nad->sun_path));
}
break;
#endif
diff --git a/libguile/stime.c b/libguile/stime.c
index dce728053..4dc3d3244 100644
--- a/libguile/stime.c
+++ b/libguile/stime.c
@@ -186,11 +186,11 @@ SCM_DEFINE (scm_times, "times", 0, 0, 0,
rv = times (&t);
if (rv == -1)
SCM_SYSERROR;
- SCM_VECTOR_SET (result, 0, scm_from_long (rv));
- SCM_VECTOR_SET (result, 1, scm_from_long (t.tms_utime));
- SCM_VECTOR_SET (result, 2, scm_from_long (t.tms_stime));
- SCM_VECTOR_SET (result ,3, scm_from_long (t.tms_cutime));
- SCM_VECTOR_SET (result, 4, scm_from_long (t.tms_cstime));
+ SCM_SIMPLE_VECTOR_SET (result, 0, scm_from_long (rv));
+ SCM_SIMPLE_VECTOR_SET (result, 1, scm_from_long (t.tms_utime));
+ SCM_SIMPLE_VECTOR_SET (result, 2, scm_from_long (t.tms_stime));
+ SCM_SIMPLE_VECTOR_SET (result ,3, scm_from_long (t.tms_cutime));
+ SCM_SIMPLE_VECTOR_SET (result, 4, scm_from_long (t.tms_cstime));
return result;
}
#undef FUNC_NAME
@@ -293,19 +293,19 @@ filltime (struct tm *bd_time, int zoff, const char *zname)
{
SCM result = scm_c_make_vector (11, SCM_UNDEFINED);
- SCM_VECTOR_SET (result,0, scm_from_int (bd_time->tm_sec));
- SCM_VECTOR_SET (result,1, scm_from_int (bd_time->tm_min));
- SCM_VECTOR_SET (result,2, scm_from_int (bd_time->tm_hour));
- SCM_VECTOR_SET (result,3, scm_from_int (bd_time->tm_mday));
- SCM_VECTOR_SET (result,4, scm_from_int (bd_time->tm_mon));
- SCM_VECTOR_SET (result,5, scm_from_int (bd_time->tm_year));
- SCM_VECTOR_SET (result,6, scm_from_int (bd_time->tm_wday));
- SCM_VECTOR_SET (result,7, scm_from_int (bd_time->tm_yday));
- SCM_VECTOR_SET (result,8, scm_from_int (bd_time->tm_isdst));
- SCM_VECTOR_SET (result,9, scm_from_int (zoff));
- SCM_VECTOR_SET (result,10, (zname
- ? scm_from_locale_string (zname)
- : SCM_BOOL_F));
+ SCM_SIMPLE_VECTOR_SET (result,0, scm_from_int (bd_time->tm_sec));
+ SCM_SIMPLE_VECTOR_SET (result,1, scm_from_int (bd_time->tm_min));
+ SCM_SIMPLE_VECTOR_SET (result,2, scm_from_int (bd_time->tm_hour));
+ SCM_SIMPLE_VECTOR_SET (result,3, scm_from_int (bd_time->tm_mday));
+ SCM_SIMPLE_VECTOR_SET (result,4, scm_from_int (bd_time->tm_mon));
+ SCM_SIMPLE_VECTOR_SET (result,5, scm_from_int (bd_time->tm_year));
+ SCM_SIMPLE_VECTOR_SET (result,6, scm_from_int (bd_time->tm_wday));
+ SCM_SIMPLE_VECTOR_SET (result,7, scm_from_int (bd_time->tm_yday));
+ SCM_SIMPLE_VECTOR_SET (result,8, scm_from_int (bd_time->tm_isdst));
+ SCM_SIMPLE_VECTOR_SET (result,9, scm_from_int (zoff));
+ SCM_SIMPLE_VECTOR_SET (result,10, (zname
+ ? scm_from_locale_string (zname)
+ : SCM_BOOL_F));
return result;
}
@@ -483,35 +483,25 @@ SCM_DEFINE (scm_gmtime, "gmtime", 1, 0, 0,
static void
bdtime2c (SCM sbd_time, struct tm *lt, int pos, const char *subr)
{
- SCM const *velts;
- int i;
-
- SCM_ASSERT (SCM_VECTORP (sbd_time)
- && SCM_VECTOR_LENGTH (sbd_time) == 11,
- sbd_time, pos, subr);
- velts = SCM_VELTS (sbd_time);
- for (i = 0; i < 10; i++)
- {
- SCM_ASSERT (scm_is_integer (velts[i]), sbd_time, pos, subr);
- }
- SCM_ASSERT (scm_is_false (velts[10]) || scm_is_string (velts[10]),
+ SCM_ASSERT (scm_is_simple_vector (sbd_time)
+ && SCM_SIMPLE_VECTOR_LENGTH (sbd_time) == 11,
sbd_time, pos, subr);
- lt->tm_sec = scm_to_int (velts[0]);
- lt->tm_min = scm_to_int (velts[1]);
- lt->tm_hour = scm_to_int (velts[2]);
- lt->tm_mday = scm_to_int (velts[3]);
- lt->tm_mon = scm_to_int (velts[4]);
- lt->tm_year = scm_to_int (velts[5]);
- lt->tm_wday = scm_to_int (velts[6]);
- lt->tm_yday = scm_to_int (velts[7]);
- lt->tm_isdst = scm_to_int (velts[8]);
+ lt->tm_sec = scm_to_int (SCM_SIMPLE_VECTOR_REF (sbd_time, 0));
+ lt->tm_min = scm_to_int (SCM_SIMPLE_VECTOR_REF (sbd_time, 1));
+ lt->tm_hour = scm_to_int (SCM_SIMPLE_VECTOR_REF (sbd_time, 2));
+ lt->tm_mday = scm_to_int (SCM_SIMPLE_VECTOR_REF (sbd_time, 3));
+ lt->tm_mon = scm_to_int (SCM_SIMPLE_VECTOR_REF (sbd_time, 4));
+ lt->tm_year = scm_to_int (SCM_SIMPLE_VECTOR_REF (sbd_time, 5));
+ lt->tm_wday = scm_to_int (SCM_SIMPLE_VECTOR_REF (sbd_time, 6));
+ lt->tm_yday = scm_to_int (SCM_SIMPLE_VECTOR_REF (sbd_time, 7));
+ lt->tm_isdst = scm_to_int (SCM_SIMPLE_VECTOR_REF (sbd_time, 8));
#ifdef HAVE_TM_ZONE
- lt->tm_gmtoff = scm_to_int (velts[9]);
- if (scm_is_false (velts[10]))
+ lt->tm_gmtoff = scm_to_int (SCM_SIMPLE_VECTOR_REF (sbd_time, 9));
+ if (scm_is_false (SCM_SIMPLE_VECTOR_REF (sbd_time, 10)))
lt->tm_zone = NULL;
else
- lt->tm_zone = scm_to_locale_string (velts[10]);
+ lt->tm_zone = scm_to_locale_string (SCM_SIMPLE_VECTOR_REF (sbd_time, 10));
#endif
}
diff --git a/libguile/symbols.c b/libguile/symbols.c
index b265e5ce4..204bc7446 100644
--- a/libguile/symbols.c
+++ b/libguile/symbols.c
@@ -98,7 +98,7 @@ scm_i_mem2symbol (SCM str)
SCM l;
- for (l = SCM_HASHTABLE_BUCKETS (symbols) [hash];
+ for (l = SCM_HASHTABLE_BUCKET (symbols, hash);
!scm_is_null (l);
l = SCM_CDR (l))
{
@@ -128,7 +128,7 @@ scm_i_mem2symbol (SCM str)
SCM symbol = scm_i_make_symbol (str, 0, raw_hash,
scm_cons (SCM_BOOL_F, SCM_EOL));
- SCM slot = SCM_HASHTABLE_BUCKETS (symbols) [hash];
+ SCM slot = SCM_HASHTABLE_BUCKET (symbols, hash);
SCM cell = scm_cons (symbol, SCM_UNDEFINED);
SCM_SET_HASHTABLE_BUCKET (symbols, hash, scm_cons (cell, slot));
SCM_HASHTABLE_INCREMENT (symbols);
diff --git a/libguile/tags.h b/libguile/tags.h
index 5b317c074..6a6c35233 100644
--- a/libguile/tags.h
+++ b/libguile/tags.h
@@ -438,7 +438,6 @@ typedef unsigned long scm_t_bits;
#define scm_tc7_pws 31
-#if SCM_HAVE_ARRAYS
#define scm_tc7_unused_1 29
#define scm_tc7_unused_2 37
#define scm_tc7_unused_3 45
@@ -448,7 +447,6 @@ typedef unsigned long scm_t_bits;
#define scm_tc7_unused_7 71
#define scm_tc7_unused_8 77
#define scm_tc7_unused_9 79
-#endif
#define scm_tc7_dsubr 61
#define scm_tc7_cclo 63
diff --git a/libguile/vports.c b/libguile/vports.c
index 199c27a0a..9e248e65e 100644
--- a/libguile/vports.c
+++ b/libguile/vports.c
@@ -58,12 +58,13 @@ sf_flush (SCM port)
if (pt->write_pos > pt->write_buf)
{
/* write the byte. */
- scm_call_1 (SCM_VELTS (stream)[0], SCM_MAKE_CHAR (*pt->write_buf));
+ scm_call_1 (SCM_SIMPLE_VECTOR_REF (stream, 0),
+ SCM_MAKE_CHAR (*pt->write_buf));
pt->write_pos = pt->write_buf;
/* flush the output. */
{
- SCM f = SCM_VELTS (stream)[2];
+ SCM f = SCM_SIMPLE_VECTOR_REF (stream, 2);
if (scm_is_true (f))
scm_call_0 (f);
@@ -76,7 +77,8 @@ sf_write (SCM port, const void *data, size_t size)
{
SCM p = SCM_PACK (SCM_STREAM (port));
- scm_call_1 (SCM_VELTS (p)[1], scm_from_locale_stringn ((char *) data, size));
+ scm_call_1 (SCM_SIMPLE_VECTOR_REF (p, 1),
+ scm_from_locale_stringn ((char *) data, size));
}
/* calling the flush proc (element 2) is in case old code needs it,
@@ -90,7 +92,7 @@ sf_fill_input (SCM port)
SCM p = SCM_PACK (SCM_STREAM (port));
SCM ans;
- ans = scm_call_0 (SCM_VELTS (p)[3]); /* get char. */
+ ans = scm_call_0 (SCM_SIMPLE_VECTOR_REF (p, 3)); /* get char. */
if (scm_is_false (ans) || SCM_EOF_OBJECT_P (ans))
return EOF;
SCM_ASSERT (SCM_CHARP (ans), ans, SCM_ARG1, "sf_fill_input");
@@ -109,7 +111,7 @@ static int
sf_close (SCM port)
{
SCM p = SCM_PACK (SCM_STREAM (port));
- SCM f = SCM_VELTS (p)[4];
+ SCM f = SCM_SIMPLE_VECTOR_REF (p, 4);
if (scm_is_false (f))
return 0;
f = scm_call_0 (f);
@@ -122,9 +124,9 @@ static int
sf_input_waiting (SCM port)
{
SCM p = SCM_PACK (SCM_STREAM (port));
- if (SCM_VECTOR_LENGTH (p) >= 6)
+ if (SCM_SIMPLE_VECTOR_LENGTH (p) >= 6)
{
- SCM f = SCM_VELTS (p)[5];
+ SCM f = SCM_SIMPLE_VECTOR_REF (p, 5);
if (scm_is_true (f))
return scm_to_int (scm_call_0 (f));
}
@@ -188,7 +190,7 @@ SCM_DEFINE (scm_make_soft_port, "make-soft-port", 2, 0, 0,
SCM z;
SCM_VALIDATE_VECTOR (1, pv);
- vlen = SCM_VECTOR_LENGTH (pv);
+ vlen = SCM_SIMPLE_VECTOR_LENGTH (pv);
SCM_ASSERT ((vlen == 5) || (vlen == 6), pv, 1, FUNC_NAME);
SCM_VALIDATE_STRING (2, modes);