mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-15 16:20:17 +02:00
Code Activity

Use new vector elements API or simple vector API, as appropriate.

Browse source 
Removed SCM_HAVE_ARRAYS ifdefery.  Replaced all uses of
SCM_HASHTABLE_BUCKETS with SCM_HASHTABLE_BUCKET.
This commit is contained in:
Marius Vollmer 2005-01-02 20:49:04 +00:00
parent f60539dba4
commit 4057a3e05a
29 changed files with 372 additions and 363 deletions
Download patch file Download diff file Expand all files Collapse all files

2
libguile/convert.c
View file

@ -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/srfi-4.h"
#include "libguile/convert.h"

2
libguile/convert.h
View file

@ -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 */

25
libguile/convert.i.c
View file

@ -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;
}

2
libguile/deprecated.c
View file

@ -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);

16
libguile/environments.c
View file

@ -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))
{

66
libguile/eval.c
View file

@ -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;

81
libguile/filesys.c
View file

@ -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
{

17
libguile/fluids.c
View file

@ -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

17
libguile/gc-mark.c
View file

@ -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. */

2
libguile/gh.h
View file

@ -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);

72
libguile/gh_data.c
View file

@ -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

47
libguile/goops.c
View file

@ -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,14 +1918,13 @@ 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) {
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);
types = p = scm_vector_writable_elements (tmp, &handle, NULL, NULL);
/*
note that we don't have to work to reset the generation
@ -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*/
v = scm_c_make_vector (len, SCM_EOL);
/* Verify that all the arguments of targs are classes and place them
in a vector
*/
for (i = 0, l = targs; !scm_is_null (l); i++, l = SCM_CDR (l)) {
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));
v_elts[i] = SCM_CAR(l);
}
return more_specificp (m1, m2, SCM_VELTS(v)) ? SCM_BOOL_T: SCM_BOOL_F;
/* 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

15
libguile/hash.c
View file

@ -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;
}
}

2
libguile/init.c
View file

@ -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 */

2
libguile/modules.c
View file

@ -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);

34
libguile/net_db.c
View file

@ -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;
}

6
libguile/objects.c
View file

@ -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

6
libguile/ports.c
View file

@ -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,

49
libguile/posix.c
View file

@ -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;
}

23
libguile/print.c
View file

@ -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);

71
libguile/random.c
View file

@ -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"

2
libguile/read.c
View file

@ -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);

6
libguile/regex-posix.c
View file

@ -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)));
}

30
libguile/scmsigs.c
View file

@ -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,19 +210,19 @@ 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,
SCM_SIMPLE_VECTOR_SET (*signal_handlers, signum, handler);
SCM_SIMPLE_VECTOR_SET (signal_cell_handlers, signum,
close_1 (handler, scm_from_int (signum)));
}
@ -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
}

24
libguile/socket.c
View file

@ -910,11 +910,11 @@ scm_addr_vector (const struct sockaddr *address, int addr_size,
result = scm_c_make_vector (3, SCM_UNSPECIFIED);
SCM_VECTOR_SET(result, 0,
SCM_SIMPLE_VECTOR_SET(result, 0,
scm_from_short (fam));
SCM_VECTOR_SET(result, 1,
SCM_SIMPLE_VECTOR_SET(result, 1,
scm_from_ulong (ntohl (nad->sin_addr.s_addr)));
SCM_VECTOR_SET(result, 2,
SCM_SIMPLE_VECTOR_SET(result, 2,
scm_from_ushort (ntohs (nad->sin_port)));
}
break;
@ -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

70
libguile/stime.c
View file

@ -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,17 +293,17 @@ 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_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
}

4
libguile/symbols.c
View file

@ -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);

2
libguile/tags.h
View file

@ -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

18
libguile/vports.c
View file

@ -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);