mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-16 00:30:21 +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/strings.h"
#include "libguile/vectors.h" #include "libguile/vectors.h"
#include "libguile/pairs.h" #include "libguile/pairs.h"
#if SCM_HAVE_ARRAYS
#include "libguile/unif.h" #include "libguile/unif.h"
#endif
#include "libguile/srfi-4.h" #include "libguile/srfi-4.h"
#include "libguile/convert.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_floats2scm (const float *src, long n);
SCM_API SCM scm_c_doubles2scm (const double *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_chars2byvect (const char *src, long n);
SCM_API SCM scm_c_shorts2svect (const short *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); 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_ulongs2uvect (const unsigned long *src, long n);
SCM_API SCM scm_c_floats2fvect (const float *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); SCM_API SCM scm_c_doubles2dvect (const double *src, long n);
#endif
#endif /* SCM_CONVERT_H */ #endif /* SCM_CONVERT_H */

25
libguile/convert.i.c
View file

@ -66,19 +66,19 @@
CTYPE * CTYPE *
SCM2CTYPES (SCM obj, CTYPE *data) 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; const UVEC_CTYPE *uvec_elements;
obj = F(scm_any_to_,UVEC_TAG,vector) (obj); 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, &handle, &len, &inc);
uvec_elements = F(scm_,UVEC_TAG,vector_elements) (obj);
if (data == NULL) if (data == NULL)
data = scm_malloc (len * sizeof (CTYPE)); 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]; data[i] = uvec_elements[i];
scm_uniform_vector_release_elements (obj);
return data; return data;
} }
@ -93,7 +93,7 @@ CTYPES2SCM (const CTYPE *data, long n)
v = scm_c_make_vector (n, SCM_UNSPECIFIED); v = scm_c_make_vector (n, SCM_UNSPECIFIED);
for (i = 0; i < n; i++) 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; return v;
} }
@ -103,17 +103,17 @@ CTYPES2SCM (const CTYPE *data, long n)
SCM SCM
CTYPES2UVECT (const CTYPE *data, long n) CTYPES2UVECT (const CTYPE *data, long n)
{ {
scm_t_array_handle handle;
long i; long i;
SCM uvec; SCM uvec;
UVEC_CTYPE *uvec_elements; UVEC_CTYPE *uvec_elements;
uvec = F(scm_make_,UVEC_TAG,vector) (scm_from_long (n), SCM_UNDEFINED); 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++) for (i = 0; i < n; i++)
uvec_elements[i] = data[i]; uvec_elements[i] = data[i];
scm_uniform_vector_release_writable_elements (uvec);
return uvec; return uvec;
} }
@ -122,17 +122,18 @@ CTYPES2UVECT (const CTYPE *data, long n)
SCM SCM
CTYPES2UVECT_2 (const CTYPE_2 *data, long n) CTYPES2UVECT_2 (const CTYPE_2 *data, long n)
{ {
scm_t_array_handle handle;
long i; long i;
SCM uvec; SCM uvec;
UVEC_CTYPE_2 *uvec_elements; UVEC_CTYPE_2 *uvec_elements;
uvec = F(scm_make_,UVEC_TAG_2,vector) (scm_from_long (n), SCM_UNDEFINED); 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++) for (i = 0; i < n; i++)
v[i] = data[i]; uvec_elements[i] = data[i];
scm_uniform_vector_release (uvec);
return 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)) if (SCM_UNBNDP (obarray))
return scm_gensym (prefix); return scm_gensym (prefix);
else else
SCM_ASSERT ((SCM_VECTORP (obarray) || SCM_WVECTP (obarray)), SCM_ASSERT ((scm_is_vector (obarray) || SCM_I_WVECTP (obarray)),
obarray, obarray,
SCM_ARG2, SCM_ARG2,
FUNC_NAME); 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); size_t hash = scm_i_symbol_hash (symbol) % SCM_HASHTABLE_N_BUCKETS (obarray);
SCM entry = scm_cons (symbol, data); 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); SCM_SET_HASHTABLE_BUCKET (obarray, hash, slot);
if (SCM_HASHTABLE_N_ITEMS (obarray) > SCM_HASHTABLE_UPPER (obarray)) if (SCM_HASHTABLE_N_ITEMS (obarray) > SCM_HASHTABLE_UPPER (obarray))
scm_i_rehash (obarray, scm_i_hash_symbol, 0, "obarray_enter"); 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 lsym;
SCM slot; SCM slot;
for (lsym = SCM_HASHTABLE_BUCKETS (obarray)[hash]; for (lsym = SCM_HASHTABLE_BUCKET (obarray, hash);
!scm_is_null (lsym); !scm_is_null (lsym);
lsym = SCM_CDR (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); SCM_SET_HASHTABLE_BUCKET (obarray, hash, slot);
if (SCM_HASHTABLE_N_ITEMS (obarray) > SCM_HASHTABLE_UPPER (obarray)) if (SCM_HASHTABLE_N_ITEMS (obarray) > SCM_HASHTABLE_UPPER (obarray))
scm_i_rehash (obarray, scm_i_hash_symbol, 0, "obarray_replace"); 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); size_t hash = scm_i_symbol_hash (sym) % SCM_HASHTABLE_N_BUCKETS (obarray);
SCM lsym; SCM lsym;
for (lsym = SCM_HASHTABLE_BUCKETS (obarray)[hash]; for (lsym = SCM_HASHTABLE_BUCKET (obarray, hash);
!scm_is_null (lsym); !scm_is_null (lsym);
lsym = SCM_CDR (lsym)) lsym = SCM_CDR (lsym))
{ {
@ -581,7 +581,7 @@ static SCM
obarray_remove (SCM obarray, SCM sym) obarray_remove (SCM obarray, SCM sym)
{ {
size_t hash = scm_i_symbol_hash (sym) % SCM_HASHTABLE_N_BUCKETS (obarray); 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); SCM handle = scm_sloppy_assq (sym, table_entry);
if (scm_is_pair (handle)) if (scm_is_pair (handle))
@ -634,9 +634,9 @@ struct core_environments_base {
#define CORE_ENVIRONMENT_WEAK_OBSERVER_VECTOR(env) \ #define CORE_ENVIRONMENT_WEAK_OBSERVER_VECTOR(env) \
(CORE_ENVIRONMENTS_BASE (env)->weak_observers) (CORE_ENVIRONMENTS_BASE (env)->weak_observers)
#define CORE_ENVIRONMENT_WEAK_OBSERVERS(env) \ #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) \ #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++) for (i = 0; i < SCM_HASHTABLE_N_BUCKETS (obarray); i++)
{ {
SCM l; SCM l;
for (l = SCM_HASHTABLE_BUCKETS (obarray)[i]; for (l = SCM_HASHTABLE_BUCKET (obarray, i);
!scm_is_null (l); !scm_is_null (l);
l = SCM_CDR (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); const SCM sym = scm_module_reverse_lookup (scm_env_module (env), expr);
return scm_is_true (sym) ? sym : sym_three_question_marks; 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); 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), return scm_cons (iqq (SCM_CAR (form), env, depth),
iqq (SCM_CDR (form), env, depth)); iqq (SCM_CDR (form), env, depth));
} }
else if (SCM_VECTORP (form)) else if (scm_is_vector (form))
{ return scm_vector (iqq (scm_vector_to_list (form), env, depth));
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 else
return form; return form;
} }
@ -3755,7 +3747,7 @@ dispatch:
* complicated one, and a simple one. For the complicated one * complicated one, and a simple one. For the complicated one
* explained below, tmp holds a number that is used in the * explained below, tmp holds a number that is used in the
* computation. */ * computation. */
if (SCM_VECTORP (tmp)) if (scm_is_simple_vector (tmp))
{ {
/* This method of determining the hash value is much /* This method of determining the hash value is much
* simpler: Set the hash value to zero and just perform a * simpler: Set the hash value to zero and just perform a
@ -3763,7 +3755,7 @@ dispatch:
method_cache = tmp; method_cache = tmp;
mask = (unsigned long int) ((long) -1); mask = (unsigned long int) ((long) -1);
hash_value = 0; hash_value = 0;
cache_end_pos = SCM_VECTOR_LENGTH (method_cache); cache_end_pos = SCM_SIMPLE_VECTOR_LENGTH (method_cache);
} }
else else
{ {
@ -3814,7 +3806,7 @@ dispatch:
do do
{ {
SCM args = arg1; /* list of arguments */ 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)) while (!scm_is_null (args))
{ {
/* More arguments than specifiers => CLASS != ENV */ /* More arguments than specifiers => CLASS != ENV */
@ -5393,26 +5385,24 @@ check_map_args (SCM argv,
SCM args, SCM args,
const char *who) const char *who)
{ {
SCM const *ve = SCM_VELTS (argv);
long i; 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 (elt_len < 0)
{ {
if (gf) if (gf)
scm_apply_generic (gf, scm_cons (proc, args)); scm_apply_generic (gf, scm_cons (proc, args));
else else
scm_wrong_type_arg (who, i + 2, ve[i]); scm_wrong_type_arg (who, i + 2, elt);
} }
if (elt_len != len) 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; long i, len;
SCM res = SCM_EOL; SCM res = SCM_EOL;
SCM *pres = &res; SCM *pres = &res;
SCM const *ve = &args; /* Keep args from being optimized away. */
len = scm_ilength (arg1); len = scm_ilength (arg1);
SCM_GASSERTn (len >= 0, SCM_GASSERTn (len >= 0,
@ -5472,17 +5461,17 @@ scm_map (SCM proc, SCM arg1, SCM args)
} }
arg1 = scm_cons (arg1, args); arg1 = scm_cons (arg1, args);
args = scm_vector (arg1); args = scm_vector (arg1);
ve = SCM_VELTS (args);
check_map_args (args, len, g_map, proc, arg1, s_map); check_map_args (args, len, g_map, proc, arg1, s_map);
while (1) while (1)
{ {
arg1 = SCM_EOL; 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; return res;
arg1 = scm_cons (SCM_CAR (ve[i]), arg1); arg1 = scm_cons (SCM_CAR (elt), arg1);
SCM_VECTOR_SET (args, i, SCM_CDR (ve[i])); SCM_SIMPLE_VECTOR_SET (args, i, SCM_CDR (elt));
} }
*pres = scm_list_1 (scm_apply (proc, arg1, SCM_EOL)); *pres = scm_list_1 (scm_apply (proc, arg1, SCM_EOL));
pres = SCM_CDRLOC (*pres); pres = SCM_CDRLOC (*pres);
@ -5497,7 +5486,6 @@ SCM
scm_for_each (SCM proc, SCM arg1, SCM args) scm_for_each (SCM proc, SCM arg1, SCM args)
#define FUNC_NAME s_for_each #define FUNC_NAME s_for_each
{ {
SCM const *ve = &args; /* Keep args from being optimized away. */
long i, len; long i, len;
len = scm_ilength (arg1); len = scm_ilength (arg1);
SCM_GASSERTn (len >= 0, g_for_each, scm_cons2 (proc, arg1, args), 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); arg1 = scm_cons (arg1, args);
args = scm_vector (arg1); args = scm_vector (arg1);
ve = SCM_VELTS (args);
check_map_args (args, len, g_for_each, proc, arg1, s_for_each); check_map_args (args, len, g_for_each, proc, arg1, s_for_each);
while (1) while (1)
{ {
arg1 = SCM_EOL; 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; return SCM_UNSPECIFIED;
arg1 = scm_cons (SCM_CAR (ve[i]), arg1); arg1 = scm_cons (SCM_CAR (elt), arg1);
SCM_VECTOR_SET (args, i, SCM_CDR (ve[i])); SCM_SIMPLE_VECTOR_SET (args, i, SCM_CDR (elt));
} }
scm_apply (proc, arg1, SCM_EOL); scm_apply (proc, arg1, SCM_EOL);
} }
@ -5683,7 +5671,7 @@ copy_tree (
struct t_trace *tortoise, struct t_trace *tortoise,
unsigned int tortoise_delay ) 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; return hare->obj;
} }
@ -5711,10 +5699,10 @@ copy_tree (
--tortoise_delay; --tortoise_delay;
} }
if (SCM_VECTORP (hare->obj)) if (scm_is_simple_vector (hare->obj))
{ {
const unsigned long int length = SCM_VECTOR_LENGTH (hare->obj); size_t length = SCM_SIMPLE_VECTOR_LENGTH (hare->obj);
const SCM new_vector = scm_c_make_vector (length, SCM_UNSPECIFIED); SCM new_vector = scm_c_make_vector (length, SCM_UNSPECIFIED);
/* Each vector element is copied by recursing into copy_tree, having /* Each vector element is copied by recursing into copy_tree, having
* the tortoise follow the hare into the depths of the stack. */ * the tortoise follow the hare into the depths of the stack. */
@ -5722,9 +5710,9 @@ copy_tree (
for (i = 0; i < length; ++i) for (i = 0; i < length; ++i)
{ {
SCM new_element; 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); 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; 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 ans = scm_c_make_vector (15, SCM_UNSPECIFIED);
SCM_VECTOR_SET(ans, 0, scm_from_ulong (stat_temp->st_dev)); SCM_SIMPLE_VECTOR_SET(ans, 0, scm_from_ulong (stat_temp->st_dev));
SCM_VECTOR_SET(ans, 1, scm_from_ulong (stat_temp->st_ino)); SCM_SIMPLE_VECTOR_SET(ans, 1, scm_from_ulong (stat_temp->st_ino));
SCM_VECTOR_SET(ans, 2, scm_from_ulong (stat_temp->st_mode)); SCM_SIMPLE_VECTOR_SET(ans, 2, scm_from_ulong (stat_temp->st_mode));
SCM_VECTOR_SET(ans, 3, scm_from_ulong (stat_temp->st_nlink)); SCM_SIMPLE_VECTOR_SET(ans, 3, scm_from_ulong (stat_temp->st_nlink));
SCM_VECTOR_SET(ans, 4, scm_from_ulong (stat_temp->st_uid)); SCM_SIMPLE_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, 5, scm_from_ulong (stat_temp->st_gid));
#ifdef HAVE_STRUCT_STAT_ST_RDEV #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 #else
SCM_VECTOR_SET(ans, 6, SCM_BOOL_F); SCM_SIMPLE_VECTOR_SET(ans, 6, SCM_BOOL_F);
#endif #endif
SCM_VECTOR_SET(ans, 7, scm_from_ulong (stat_temp->st_size)); SCM_SIMPLE_VECTOR_SET(ans, 7, scm_from_ulong (stat_temp->st_size));
SCM_VECTOR_SET(ans, 8, scm_from_ulong (stat_temp->st_atime)); SCM_SIMPLE_VECTOR_SET(ans, 8, scm_from_ulong (stat_temp->st_atime));
SCM_VECTOR_SET(ans, 9, scm_from_ulong (stat_temp->st_mtime)); SCM_SIMPLE_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, 10, scm_from_ulong (stat_temp->st_ctime));
#ifdef HAVE_STRUCT_STAT_ST_BLKSIZE #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 #else
SCM_VECTOR_SET(ans, 11, scm_from_ulong (4096L)); SCM_SIMPLE_VECTOR_SET(ans, 11, scm_from_ulong (4096L));
#endif #endif
#ifdef HAVE_STRUCT_STAT_ST_BLOCKS #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 #else
SCM_VECTOR_SET(ans, 12, SCM_BOOL_F); SCM_SIMPLE_VECTOR_SET(ans, 12, SCM_BOOL_F);
#endif #endif
{ {
int mode = stat_temp->st_mode; int mode = stat_temp->st_mode;
if (S_ISREG (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)) 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 #ifdef HAVE_S_ISLNK
else if (S_ISLNK (mode)) else if (S_ISLNK (mode))
SCM_VECTOR_SET(ans, 13, scm_sym_symlink); SCM_SIMPLE_VECTOR_SET(ans, 13, scm_sym_symlink);
#endif #endif
else if (S_ISBLK (mode)) 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)) 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)) 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 #ifdef S_ISSOCK
else if (S_ISSOCK (mode)) else if (S_ISSOCK (mode))
SCM_VECTOR_SET(ans, 13, scm_sym_sock); SCM_SIMPLE_VECTOR_SET(ans, 13, scm_sym_sock);
#endif #endif
else 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. /* the layout of the bits in ve[14] is intended to be portable.
If there are systems that don't follow the usual convention, If there are systems that don't follow the usual convention,
@ -531,7 +531,7 @@ scm_stat2scm (struct stat *stat_temp)
tmp <<= 1; tmp <<= 1;
if (S_IXOTH & mode) 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; 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); int i = SCM_SIMPLE_VECTOR_LENGTH (list_or_vec);
SCM const *ve = SCM_VELTS (list_or_vec);
while (--i >= 0) 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) if (fd > max_fd)
max_fd = 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; 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); int i = SCM_SIMPLE_VECTOR_LENGTH (list_or_vec);
SCM const *ve = SCM_VELTS (list_or_vec);
while (--i >= 0) 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); return scm_vector (answer_list);
} }
@ -1177,27 +1178,27 @@ SCM_DEFINE (scm_select, "select", 3, 2, 0,
SCM write_ports_ready = SCM_EOL; SCM write_ports_ready = SCM_EOL;
int max_fd; 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 else
{ {
read_count = scm_ilength (reads); read_count = scm_ilength (reads);
SCM_ASSERT (read_count >= 0, reads, SCM_ARG1, FUNC_NAME); 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 else
{ {
write_count = scm_ilength (writes); write_count = scm_ilength (writes);
SCM_ASSERT (write_count >= 0, writes, SCM_ARG2, FUNC_NAME); 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 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; long old_length, i;
old_fluids = root_state->fluids; 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); new_fluids = scm_c_make_vector (new_length, SCM_BOOL_F);
i = 0; i = 0;
while (i < old_length) 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++; i++;
} }
while (i < new_length) while (i < new_length)
{ {
SCM_VECTOR_SET (new_fluids, i, SCM_BOOL_F); SCM_SIMPLE_VECTOR_SET (new_fluids, i, SCM_BOOL_F);
i++; i++;
} }
@ -67,7 +68,7 @@ grow_fluids (scm_root_state *root_state, int new_length)
void void
scm_i_copy_fluids (scm_root_state *root_state) 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 static int
@ -129,9 +130,9 @@ SCM_DEFINE (scm_fluid_ref, "fluid-ref", 1, 0, 0,
SCM_VALIDATE_FLUID (1, fluid); SCM_VALIDATE_FLUID (1, fluid);
n = SCM_FLUID_NUM (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); 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 #undef FUNC_NAME
@ -145,9 +146,9 @@ SCM_DEFINE (scm_fluid_set_x, "fluid-set!", 2, 0, 0,
SCM_VALIDATE_FLUID (1, fluid); SCM_VALIDATE_FLUID (1, fluid);
n = SCM_FLUID_NUM (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); 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; return SCM_UNSPECIFIED;
} }
#undef FUNC_NAME #undef FUNC_NAME

17
libguile/gc-mark.c
View file

@ -86,7 +86,7 @@ scm_mark_all (void)
size_t i; size_t i;
for (i = 0; i < SCM_HASHTABLE_N_BUCKETS (scm_gc_registered_roots); ++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)) for (; !scm_is_null (l); l = SCM_CDR (l))
{ {
SCM *p = (SCM *) (scm_to_ulong (SCM_CAAR (l))); SCM *p = (SCM *) (scm_to_ulong (SCM_CAAR (l)));
@ -223,15 +223,16 @@ scm_gc_mark_dependencies (SCM p)
ptr = SCM_ENV (ptr); ptr = SCM_ENV (ptr);
goto gc_mark_nimp; goto gc_mark_nimp;
case scm_tc7_vector: case scm_tc7_vector:
i = SCM_VECTOR_LENGTH (ptr); i = SCM_SIMPLE_VECTOR_LENGTH (ptr);
if (i == 0) if (i == 0)
break; break;
while (--i > 0) while (--i > 0)
{ {
if (SCM_NIMP (SCM_VELTS (ptr)[i])) SCM elt = SCM_SIMPLE_VECTOR_REF (ptr, i);
scm_gc_mark (SCM_VELTS (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; goto gc_mark_loop;
#ifdef CCLO #ifdef CCLO
case scm_tc7_cclo: case scm_tc7_cclo:
@ -266,7 +267,7 @@ scm_gc_mark_dependencies (SCM p)
break; break;
case scm_tc7_wvect: 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; scm_weak_vectors = ptr;
if (SCM_IS_WHVEC_ANY (ptr)) if (SCM_IS_WHVEC_ANY (ptr))
{ {
@ -275,14 +276,14 @@ scm_gc_mark_dependencies (SCM p)
int weak_keys; int weak_keys;
int weak_values; int weak_values;
len = SCM_VECTOR_LENGTH (ptr); len = SCM_SIMPLE_VECTOR_LENGTH (ptr);
weak_keys = SCM_WVECT_WEAK_KEY_P (ptr); weak_keys = SCM_WVECT_WEAK_KEY_P (ptr);
weak_values = SCM_WVECT_WEAK_VALUE_P (ptr); weak_values = SCM_WVECT_WEAK_VALUE_P (ptr);
for (x = 0; x < len; ++x) for (x = 0; x < len; ++x)
{ {
SCM alist; SCM alist;
alist = SCM_VELTS (ptr)[x]; alist = SCM_SIMPLE_VECTOR_REF (ptr, x);
/* mark everything on the alist except the keys or /* mark everything on the alist except the keys or
* values, according to weak_values and weak_keys. */ * 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_symbol2scm(const char *symbol_str);
SCM_API SCM gh_ints2scm(const int *d, long n); 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_chars2byvect(const char *d, long n);
SCM_API SCM gh_shorts2svect(const short *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_longs2ivect(const long *d, long n);
SCM_API SCM gh_ulongs2uvect(const unsigned 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_floats2fvect(const float *d, long n);
SCM_API SCM gh_doubles2dvect(const double *d, long n); SCM_API SCM gh_doubles2dvect(const double *d, long n);
#endif
SCM_API SCM gh_doubles2scm(const double *d, long n); 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; long i;
SCM v = scm_c_make_vector (n, SCM_UNSPECIFIED); SCM v = scm_c_make_vector (n, SCM_UNSPECIFIED);
for (i = 0; i < n; ++i) 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; return v;
} }
@ -118,7 +118,7 @@ gh_doubles2scm (const double *d, long n)
SCM v = scm_c_make_vector (n, SCM_UNSPECIFIED); SCM v = scm_c_make_vector (n, SCM_UNSPECIFIED);
for(i = 0; i < n; i++) 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; return v;
} }
@ -224,10 +224,10 @@ gh_scm2chars (SCM obj, char *m)
{ {
case scm_tc7_vector: case scm_tc7_vector:
case scm_tc7_wvect: case scm_tc7_wvect:
n = SCM_VECTOR_LENGTH (obj); n = SCM_SIMPLE_VECTOR_LENGTH (obj);
for (i = 0; i < n; ++i) for (i = 0; i < n; ++i)
{ {
val = SCM_VELTS (obj)[i]; val = SCM_SIMPLE_VECTOR_REF (obj, i);
if (SCM_I_INUMP (val)) if (SCM_I_INUMP (val))
{ {
v = SCM_I_INUM (val); v = SCM_I_INUM (val);
@ -242,24 +242,29 @@ gh_scm2chars (SCM obj, char *m)
if (m == NULL) if (m == NULL)
return NULL; return NULL;
for (i = 0; i < n; ++i) 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; break;
#if SCM_HAVE_ARRAYS
case scm_tc7_smob: case scm_tc7_smob:
if (scm_is_true (scm_s8vector_p (obj))) 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) if (m == 0)
m = (char *) malloc (n * sizeof (char)); m = (char *) malloc (len);
if (m == NULL) if (m == NULL)
return NULL; return NULL;
memcpy (m, scm_s8vector_elements (obj), n * sizeof (char)); memcpy (m, elts, len);
scm_remember_upto_here_1 (obj);
break; break;
} }
else else
goto wrong_type; goto wrong_type;
#endif
case scm_tc7_string: case scm_tc7_string:
n = scm_i_string_length (obj); n = scm_i_string_length (obj);
if (m == 0) if (m == 0)
@ -278,13 +283,22 @@ gh_scm2chars (SCM obj, char *m)
static void * static void *
scm2whatever (SCM obj, void *m, size_t size) 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) if (m == 0)
m = malloc (n * sizeof (size)); m = malloc (len * sizeof (size));
if (m == NULL) if (m == NULL)
return NULL; return NULL;
memcpy (m, scm_uniform_vector_elements (obj), n * size); memcpy (m, elts, len * size);
scm_uniform_vector_release_elements (obj);
return m; return m;
} }
@ -313,10 +327,10 @@ gh_scm2shorts (SCM obj, short *m)
{ {
case scm_tc7_vector: case scm_tc7_vector:
case scm_tc7_wvect: case scm_tc7_wvect:
n = SCM_VECTOR_LENGTH (obj); n = SCM_SIMPLE_VECTOR_LENGTH (obj);
for (i = 0; i < n; ++i) for (i = 0; i < n; ++i)
{ {
val = SCM_VELTS (obj)[i]; val = SCM_SIMPLE_VECTOR_REF (obj, i);
if (SCM_I_INUMP (val)) if (SCM_I_INUMP (val))
{ {
v = SCM_I_INUM (val); v = SCM_I_INUM (val);
@ -331,7 +345,7 @@ gh_scm2shorts (SCM obj, short *m)
if (m == NULL) if (m == NULL)
return NULL; return NULL;
for (i = 0; i < n; ++i) 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; break;
default: default:
scm_wrong_type_arg (0, 0, obj); scm_wrong_type_arg (0, 0, obj);
@ -356,10 +370,10 @@ gh_scm2longs (SCM obj, long *m)
{ {
case scm_tc7_vector: case scm_tc7_vector:
case scm_tc7_wvect: case scm_tc7_wvect:
n = SCM_VECTOR_LENGTH (obj); n = SCM_SIMPLE_VECTOR_LENGTH (obj);
for (i = 0; i < n; ++i) 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)) if (!SCM_I_INUMP (val) && !SCM_BIGP (val))
scm_wrong_type_arg (0, 0, obj); scm_wrong_type_arg (0, 0, obj);
} }
@ -369,7 +383,7 @@ gh_scm2longs (SCM obj, long *m)
return NULL; return NULL;
for (i = 0; i < n; ++i) for (i = 0; i < n; ++i)
{ {
val = SCM_VELTS (obj)[i]; val = SCM_SIMPLE_VECTOR_REF (obj, i);
m[i] = SCM_I_INUMP (val) m[i] = SCM_I_INUMP (val)
? SCM_I_INUM (val) ? SCM_I_INUM (val)
: scm_to_long (val); : scm_to_long (val);
@ -400,10 +414,10 @@ gh_scm2floats (SCM obj, float *m)
{ {
case scm_tc7_vector: case scm_tc7_vector:
case scm_tc7_wvect: case scm_tc7_wvect:
n = SCM_VECTOR_LENGTH (obj); n = SCM_SIMPLE_VECTOR_LENGTH (obj);
for (i = 0; i < n; ++i) for (i = 0; i < n; ++i)
{ {
val = SCM_VELTS (obj)[i]; val = SCM_SIMPLE_VECTOR_REF (obj, i);
if (!SCM_I_INUMP (val) if (!SCM_I_INUMP (val)
&& !(SCM_BIGP (val) || SCM_REALP (val))) && !(SCM_BIGP (val) || SCM_REALP (val)))
scm_wrong_type_arg (0, 0, val); scm_wrong_type_arg (0, 0, val);
@ -414,7 +428,7 @@ gh_scm2floats (SCM obj, float *m)
return NULL; return NULL;
for (i = 0; i < n; ++i) for (i = 0; i < n; ++i)
{ {
val = SCM_VELTS (obj)[i]; val = SCM_SIMPLE_VECTOR_REF (obj, i);
if (SCM_I_INUMP (val)) if (SCM_I_INUMP (val))
m[i] = SCM_I_INUM (val); m[i] = SCM_I_INUM (val);
else if (SCM_BIGP (val)) else if (SCM_BIGP (val))
@ -448,10 +462,10 @@ gh_scm2doubles (SCM obj, double *m)
{ {
case scm_tc7_vector: case scm_tc7_vector:
case scm_tc7_wvect: case scm_tc7_wvect:
n = SCM_VECTOR_LENGTH (obj); n = SCM_SIMPLE_VECTOR_LENGTH (obj);
for (i = 0; i < n; ++i) for (i = 0; i < n; ++i)
{ {
val = SCM_VELTS (obj)[i]; val = SCM_SIMPLE_VECTOR_REF (obj, i);
if (!SCM_I_INUMP (val) if (!SCM_I_INUMP (val)
&& !(SCM_BIGP (val) || SCM_REALP (val))) && !(SCM_BIGP (val) || SCM_REALP (val)))
scm_wrong_type_arg (0, 0, val); scm_wrong_type_arg (0, 0, val);
@ -462,7 +476,7 @@ gh_scm2doubles (SCM obj, double *m)
return NULL; return NULL;
for (i = 0; i < n; ++i) for (i = 0; i < n; ++i)
{ {
val = SCM_VELTS (obj)[i]; val = SCM_SIMPLE_VECTOR_REF (obj, i);
if (SCM_I_INUMP (val)) if (SCM_I_INUMP (val))
m[i] = SCM_I_INUM (val); m[i] = SCM_I_INUM (val);
else if (SCM_BIGP (val)) else if (SCM_BIGP (val))
@ -570,10 +584,9 @@ gh_vector_ref (SCM vec, SCM pos)
unsigned long unsigned long
gh_vector_length (SCM v) 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 */ /* uniform vector support */
/* returns the length as a C unsigned long integer */ /* 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 */ /* sets an individual element in a uniform vector */
/* SCM */ /* SCM */
/* gh_list_to_uniform_array ( */ /* gh_list_to_uniform_array ( */
#endif
/* Data lookups between C and Scheme /* 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); SCM z = scm_c_make_vector (len, SCM_UNDEFINED);
for (j = 0; j < len; j++, l = SCM_CDR (l)) { 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; return z;
} }
@ -1848,6 +1848,7 @@ sort_applicable_methods (SCM method_list, long size, SCM const *targs)
SCM *v, vector = SCM_EOL; SCM *v, vector = SCM_EOL;
SCM buffer[BUFFSIZE]; SCM buffer[BUFFSIZE];
SCM save = method_list; SCM save = method_list;
scm_t_array_handle handle;
/* For reasonably sized method_lists we can try to avoid all the /* For reasonably sized method_lists we can try to avoid all the
* consing and reorder the list in place... * 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 */ /* Too many elements in method_list to keep everything locally */
vector = scm_i_vector2list (save, size); vector = scm_i_vector2list (save, size);
v = scm_vector_writable_elements (vector, &handle, NULL, NULL);
/*
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);
} }
/* Use a simple shell sort since it is generally faster than qsort on /* 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; return save;
} }
/* If we are here, that's that we did it the hard way... */ /* If we are here, that's that we did it the hard way... */
return scm_vector_to_list (vector); 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 const *types;
SCM *p; SCM *p;
SCM tmp = SCM_EOL; SCM tmp = SCM_EOL;
scm_t_array_handle handle;
/* Build the list of arguments types */ /* Build the list of arguments types */
if (len >= BUFFSIZE) { if (len >= BUFFSIZE)
{
tmp = scm_c_make_vector (len, SCM_UNDEFINED); tmp = scm_c_make_vector (len, SCM_UNDEFINED);
/* NOTE: Using pointers to malloced memory won't work if we types = p = scm_vector_writable_elements (tmp, &handle, NULL, NULL);
1. have preemtive threading, and,
2. have a GC which moves objects. */
types = p = SCM_WRITABLE_VELTS(tmp);
/* /*
note that we don't have to work to reset the generation 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; return SCM_BOOL_F;
} }
scm_remember_upto_here_1 (tmp);
return (count == 1 return (count == 1
? applicable ? applicable
: sort_applicable_methods (applicable, count, types)); : 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 #define FUNC_NAME s_scm_sys_method_more_specific_p
{ {
SCM l, v; SCM l, v, result;
SCM *v_elts;
long i, len; long i, len;
scm_t_array_handle handle;
SCM_VALIDATE_METHOD (1, m1); SCM_VALIDATE_METHOD (1, m1);
SCM_VALIDATE_METHOD (2, m2); SCM_VALIDATE_METHOD (2, m2);
SCM_ASSERT ((len = scm_ilength (targs)) != -1, targs, SCM_ARG3, FUNC_NAME); 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
v = scm_c_make_vector (len, SCM_EOL); 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_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 #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_wvect:
case scm_tc7_vector: case scm_tc7_vector:
{ {
size_t len = SCM_VECTOR_LENGTH(obj); size_t len = SCM_SIMPLE_VECTOR_LENGTH (obj);
SCM const *data = SCM_VELTS(obj);
if (len > 5) if (len > 5)
{ {
size_t i = d/2; size_t i = d/2;
unsigned long h = 1; 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; return h;
} }
else else
{ {
size_t i = len; size_t i = len;
unsigned long h = (n)-1; 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; return h;
} }
} }

2
libguile/init.c
View file

@ -529,10 +529,8 @@ scm_init_guile_1 (SCM_STACKITEM *base)
scm_init_evalext (); scm_init_evalext ();
scm_init_debug (); /* Requires macro smobs */ scm_init_debug (); /* Requires macro smobs */
scm_init_random (); scm_init_random ();
#if SCM_HAVE_ARRAYS
scm_init_ramap (); scm_init_ramap ();
scm_init_unif (); scm_init_unif ();
#endif
scm_init_simpos (); scm_init_simpos ();
scm_init_load_path (); scm_init_load_path ();
scm_init_standard_ports (); /* Requires fports */ 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); n = SCM_HASHTABLE_N_BUCKETS (obarray);
for (i = 0; i < n; ++i) 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)) while (!scm_is_null (ls))
{ {
handle = SCM_CAR (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) if (!entry)
scm_resolv_error (FUNC_NAME, host); scm_resolv_error (FUNC_NAME, host);
SCM_VECTOR_SET(result, 0, scm_from_locale_string (entry->h_name)); SCM_SIMPLE_VECTOR_SET(result, 0, scm_from_locale_string (entry->h_name));
SCM_VECTOR_SET(result, 1, scm_makfromstrs (-1, entry->h_aliases)); SCM_SIMPLE_VECTOR_SET(result, 1, scm_makfromstrs (-1, entry->h_aliases));
SCM_VECTOR_SET(result, 2, scm_from_int (entry->h_addrtype)); SCM_SIMPLE_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, 3, scm_from_int (entry->h_length));
if (sizeof (struct in_addr) != 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; return result;
} }
for (argv = entry->h_addr_list; argv[i]; i++); 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]; inad = *(struct in_addr *) argv[i];
lst = scm_cons (scm_from_ulong (ntohl (inad.s_addr)), lst); 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; return result;
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -248,10 +248,10 @@ SCM_DEFINE (scm_getnet, "getnet", 0, 1, 0,
if (!entry) if (!entry)
SCM_SYSERROR_MSG ("no such network ~A", scm_list_1 (net), eno); 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_SIMPLE_VECTOR_SET(result, 0, scm_from_locale_string (entry->n_name));
SCM_VECTOR_SET(result, 1, scm_makfromstrs (-1, entry->n_aliases)); SCM_SIMPLE_VECTOR_SET(result, 1, scm_makfromstrs (-1, entry->n_aliases));
SCM_VECTOR_SET(result, 2, scm_from_int (entry->n_addrtype)); SCM_SIMPLE_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, 3, scm_from_ulong (entry->n_net));
return result; return result;
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -300,9 +300,9 @@ SCM_DEFINE (scm_getproto, "getproto", 0, 1, 0,
if (!entry) if (!entry)
SCM_SYSERROR_MSG ("no such protocol ~A", scm_list_1 (protocol), eno); 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_SIMPLE_VECTOR_SET(result, 0, scm_from_locale_string (entry->p_name));
SCM_VECTOR_SET(result, 1, scm_makfromstrs (-1, entry->p_aliases)); SCM_SIMPLE_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, 2, scm_from_int (entry->p_proto));
return result; return result;
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -314,10 +314,10 @@ scm_return_entry (struct servent *entry)
{ {
SCM result = scm_c_make_vector (4, SCM_UNSPECIFIED); SCM result = scm_c_make_vector (4, SCM_UNSPECIFIED);
SCM_VECTOR_SET(result, 0, scm_from_locale_string (entry->s_name)); SCM_SIMPLE_VECTOR_SET(result, 0, scm_from_locale_string (entry->s_name));
SCM_VECTOR_SET(result, 1, scm_makfromstrs (-1, entry->s_aliases)); SCM_SIMPLE_VECTOR_SET(result, 1, scm_makfromstrs (-1, entry->s_aliases));
SCM_VECTOR_SET(result, 2, scm_from_uint16 (ntohs (entry->s_port))); SCM_SIMPLE_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, 3, scm_from_locale_string (entry->s_proto));
return result; 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 */ n = scm_to_ulong (SCM_CAR (z)); /* maximum number of specializers */
methods = SCM_CADR (z); methods = SCM_CADR (z);
if (SCM_VECTORP (methods)) if (scm_is_simple_vector (methods))
{ {
/* cache format #1: prepare for linear search */ /* cache format #1: prepare for linear search */
mask = -1; mask = -1;
i = 0; i = 0;
end = SCM_VECTOR_LENGTH (methods); end = SCM_SIMPLE_VECTOR_LENGTH (methods);
} }
else else
{ {
@ -262,7 +262,7 @@ scm_mcache_lookup_cmethod (SCM cache, SCM args)
do do
{ {
long j = n; long j = n;
z = SCM_VELTS (methods)[i]; z = SCM_SIMPLE_VECTOR_REF (methods, i);
ls = args; /* list of arguments */ ls = args; /* list of arguments */
if (!scm_is_null (ls)) if (!scm_is_null (ls))
do 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; n = scm_i_port_table_size;
scm_mutex_unlock (&scm_i_port_table_mutex); 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); scm_mutex_lock (&scm_i_port_table_mutex);
if (n > scm_i_port_table_size) if (n > scm_i_port_table_size)
n = scm_i_port_table_size; n = scm_i_port_table_size;
for (i = 0; i < n; i++) 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); scm_mutex_unlock (&scm_i_port_table_mutex);
for (i = 0; i < n; i++) 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, 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); result = scm_c_make_vector (ngroups, SCM_BOOL_F);
while (--ngroups >= 0) 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); free (groups);
return result; return result;
@ -295,17 +295,18 @@ SCM_DEFINE (scm_setgroups, "setgroups", 1, 0, 0,
SCM_VALIDATE_VECTOR (SCM_ARG1, group_vec); 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 */ /* validate before allocating, so we don't have to worry about leaks */
for (i = 0; i < ngroups; i++) for (i = 0; i < ngroups; i++)
{ {
unsigned long ulong_gid; unsigned long ulong_gid;
GETGROUPS_T 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; gid = ulong_gid;
if (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); 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)); SCM_OUT_OF_RANGE (SCM_ARG1, scm_from_int (ngroups));
groups = scm_malloc (size); groups = scm_malloc (size);
for(i = 0; i < ngroups; i++) 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); result = setgroups (ngroups, groups);
save_errno = errno; /* don't let free() touch errno */ save_errno = errno; /* don't let free() touch errno */
@ -357,19 +358,19 @@ SCM_DEFINE (scm_getpwuid, "getpw", 0, 1, 0,
if (!entry) if (!entry)
SCM_MISC_ERROR ("entry not found", SCM_EOL); SCM_MISC_ERROR ("entry not found", SCM_EOL);
SCM_VECTOR_SET(result, 0, scm_from_locale_string (entry->pw_name)); SCM_SIMPLE_VECTOR_SET(result, 0, scm_from_locale_string (entry->pw_name));
SCM_VECTOR_SET(result, 1, scm_from_locale_string (entry->pw_passwd)); SCM_SIMPLE_VECTOR_SET(result, 1, scm_from_locale_string (entry->pw_passwd));
SCM_VECTOR_SET(result, 2, scm_from_ulong (entry->pw_uid)); SCM_SIMPLE_VECTOR_SET(result, 2, scm_from_ulong (entry->pw_uid));
SCM_VECTOR_SET(result, 3, scm_from_ulong (entry->pw_gid)); SCM_SIMPLE_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, 4, scm_from_locale_string (entry->pw_gecos));
if (!entry->pw_dir) if (!entry->pw_dir)
SCM_VECTOR_SET(result, 5, scm_from_locale_string ("")); SCM_SIMPLE_VECTOR_SET(result, 5, scm_from_locale_string (""));
else 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) if (!entry->pw_shell)
SCM_VECTOR_SET(result, 6, scm_from_locale_string ("")); SCM_SIMPLE_VECTOR_SET(result, 6, scm_from_locale_string (""));
else 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; return result;
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -422,10 +423,10 @@ SCM_DEFINE (scm_getgrgid, "getgr", 0, 1, 0,
if (!entry) if (!entry)
SCM_SYSERROR; SCM_SYSERROR;
SCM_VECTOR_SET(result, 0, scm_from_locale_string (entry->gr_name)); SCM_SIMPLE_VECTOR_SET(result, 0, scm_from_locale_string (entry->gr_name));
SCM_VECTOR_SET(result, 1, scm_from_locale_string (entry->gr_passwd)); SCM_SIMPLE_VECTOR_SET(result, 1, scm_from_locale_string (entry->gr_passwd));
SCM_VECTOR_SET(result, 2, scm_from_ulong (entry->gr_gid)); SCM_SIMPLE_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, 3, scm_makfromstrs (-1, entry->gr_mem));
return result; return result;
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -1053,14 +1054,14 @@ SCM_DEFINE (scm_uname, "uname", 0, 0, 0,
SCM result = scm_c_make_vector (5, SCM_UNSPECIFIED); SCM result = scm_c_make_vector (5, SCM_UNSPECIFIED);
if (uname (&buf) < 0) if (uname (&buf) < 0)
SCM_SYSERROR; SCM_SYSERROR;
SCM_VECTOR_SET(result, 0, scm_from_locale_string (buf.sysname)); SCM_SIMPLE_VECTOR_SET(result, 0, scm_from_locale_string (buf.sysname));
SCM_VECTOR_SET(result, 1, scm_from_locale_string (buf.nodename)); SCM_SIMPLE_VECTOR_SET(result, 1, scm_from_locale_string (buf.nodename));
SCM_VECTOR_SET(result, 2, scm_from_locale_string (buf.release)); SCM_SIMPLE_VECTOR_SET(result, 2, scm_from_locale_string (buf.release));
SCM_VECTOR_SET(result, 3, scm_from_locale_string (buf.version)); SCM_SIMPLE_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, 4, scm_from_locale_string (buf.machine));
/* /*
a linux special? 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; 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_make_struct (scm_print_state_vtable, SCM_INUM0, SCM_EOL);
scm_print_state *pstate = SCM_PRINT_STATE (print_state); scm_print_state *pstate = SCM_PRINT_STATE (print_state);
pstate->ref_vect = scm_c_make_vector (PSTATE_SIZE, SCM_UNDEFINED); pstate->ref_vect = scm_c_make_vector (PSTATE_SIZE, SCM_UNDEFINED);
pstate->ref_stack = SCM_WRITABLE_VELTS (pstate->ref_vect); pstate->ref_stack = SCM_SIMPLE_VECTOR_LOC (pstate->ref_vect, 0);
pstate->ceiling = SCM_VECTOR_LENGTH (pstate->ref_vect); pstate->ceiling = SCM_SIMPLE_VECTOR_LENGTH (pstate->ref_vect);
pstate->highlight_objects = SCM_EOL; pstate->highlight_objects = SCM_EOL;
return print_state; return print_state;
} }
@ -224,17 +224,17 @@ scm_i_port_with_print_state (SCM port, SCM print_state)
static void static void
grow_ref_stack (scm_print_state *pstate) grow_ref_stack (scm_print_state *pstate)
{ {
unsigned long int old_size = SCM_VECTOR_LENGTH (pstate->ref_vect); SCM old_vect = pstate->ref_vect;
SCM const *old_elts = SCM_VELTS (pstate->ref_vect); size_t old_size = SCM_SIMPLE_VECTOR_LENGTH (old_vect);
unsigned long int new_size = 2 * pstate->ceiling; size_t new_size = 2 * pstate->ceiling;
SCM new_vect = scm_c_make_vector (new_size, SCM_UNDEFINED); SCM new_vect = scm_c_make_vector (new_size, SCM_UNDEFINED);
unsigned long int i; unsigned long int i;
for (i = 0; i != old_size; ++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_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; pstate->ceiling = new_size;
} }
@ -574,9 +574,10 @@ iprin1 (SCM exp, SCM port, scm_print_state *pstate)
common_vector_printer: common_vector_printer:
{ {
register long i; register long i;
long last = SCM_VECTOR_LENGTH (exp) - 1; long last = SCM_SIMPLE_VECTOR_LENGTH (exp) - 1;
int cutp = 0; 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; last = pstate->length - 1;
cutp = 1; cutp = 1;
@ -584,13 +585,13 @@ iprin1 (SCM exp, SCM port, scm_print_state *pstate)
for (i = 0; i < last; ++i) for (i = 0; i < last; ++i)
{ {
/* CHECK_INTS; */ /* CHECK_INTS; */
scm_iprin1 (SCM_VELTS (exp)[i], port, pstate); scm_iprin1 (SCM_SIMPLE_VECTOR_REF (exp, i), port, pstate);
scm_putc (' ', port); scm_putc (' ', port);
} }
if (i == last) if (i == last)
{ {
/* CHECK_INTS; */ /* CHECK_INTS; */
scm_iprin1 (SCM_VELTS (exp)[i], port, pstate); scm_iprin1 (SCM_SIMPLE_VECTOR_REF (exp, i), port, pstate);
} }
if (cutp) if (cutp)
scm_puts (" ...", port); 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 #undef FUNC_NAME
#if SCM_HAVE_ARRAYS
static void static void
vector_scale_x (SCM v, double c) vector_scale_x (SCM v, double c)
{ {
size_t n; 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) while (n-- > 0)
SCM_REAL_VALUE (SCM_VELTS (v)[n]) *= c; SCM_REAL_VALUE (SCM_SIMPLE_VECTOR_REF (v, n)) *= c;
} }
else else
{ {
/* must be a f64vector. */ /* must be a f64vector. */
double *elts = scm_f64vector_writable_elements (v); scm_t_array_handle handle;
n = scm_c_uniform_vector_length (v); size_t i, len;
while (n-- > 0) ssize_t inc;
elts[n] *= c; double *elts;
scm_uniform_vector_release_writable_elements (v);
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; double x, sum = 0.0;
size_t n; 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) while (n-- > 0)
{ {
x = SCM_REAL_VALUE (SCM_VELTS (v)[n]); x = SCM_REAL_VALUE (SCM_SIMPLE_VECTOR_REF (v, n));
sum += x * x; sum += x * x;
} }
} }
else else
{ {
/* must be a f64vector. */ /* must be a f64vector. */
const double *elts = scm_f64vector_elements (v); scm_t_array_handle handle;
n = scm_c_uniform_vector_length (v); size_t i, len;
while (n-- > 0) 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; sum += x * x;
} }
scm_uniform_vector_release_elements (v);
} }
return sum; 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).") "(i.e., with mean 0 and variance 1).")
#define FUNC_NAME s_scm_random_normal_vector_x #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)) if (SCM_UNBNDP (state))
state = SCM_VARIABLE_REF (scm_var_random_state); state = SCM_VARIABLE_REF (scm_var_random_state);
SCM_VALIDATE_RSTATE (2, 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); SCM *elts = scm_array_handle_writable_elements (&handle);
while (n-- > 0) for (i = dim->lbnd; i <= dim->ubnd; i++, elts += dim->inc)
SCM_VECTOR_SET (v, n, *elts = scm_from_double (scm_c_normal01 (SCM_RSTATE (state)));
scm_from_double (scm_c_normal01 (SCM_RSTATE (state))));
} }
else else
{ {
/* must be a f64vector. */ /* must be a f64vector. */
double *elts = scm_f64vector_writable_elements (v); double *elts = scm_array_handle_f64_writable_elements (&handle);
n = scm_c_uniform_vector_length (v); for (i = dim->lbnd; i <= dim->ubnd; i++, elts += dim->inc)
while (n-- > 0) *elts = scm_c_normal01 (SCM_RSTATE (state));
elts[n] = scm_c_normal01 (SCM_RSTATE (state));
scm_uniform_vector_release_writable_elements (v);
} }
return SCM_UNSPECIFIED; return SCM_UNSPECIFIED;
} }
#undef FUNC_NAME #undef FUNC_NAME
#endif /* SCM_HAVE_ARRAYS */
SCM_DEFINE (scm_random_exp, "random:exp", 0, 1, 0, SCM_DEFINE (scm_random_exp, "random:exp", 0, 1, 0,
(SCM state), (SCM state),
"Return an inexact real in an exponential distribution with mean\n" "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. */ over in scm_flush_ws. */
abort (); abort ();
#if SCM_HAVE_ARRAYS
case '*': case '*':
j = scm_read_token (c, tok_buf, port, 0); j = scm_read_token (c, tok_buf, port, 0);
p = scm_istr2bve (scm_c_substring_shared (*tok_buf, 1, j)); 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; return p;
else else
goto unkshrp; goto unkshrp;
#endif
case '{': case '{':
j = scm_read_token (c, tok_buf, port, 1); 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, /* The match vector must include a cell for the string that was matched,
so add 1. */ so add 1. */
mvec = scm_c_make_vector (nmatches + 1, SCM_UNSPECIFIED); 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) for (i = 0; i < nmatches; ++i)
if (matches[i].rm_so == -1) 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))); scm_cons (scm_from_int (-1), scm_from_int (-1)));
else 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_cons (scm_from_long (matches[i].rm_so + offset),
scm_from_long (matches[i].rm_eo + 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) if (signum >= 0 && signum < NSIG)
{ {
SCM cell = SCM_VECTOR_REF(signal_handler_cells, signum); SCM cell = SCM_SIMPLE_VECTOR_REF (signal_handler_cells, signum);
SCM handler = SCM_VECTOR_REF(signal_cell_handlers, signum); SCM handler = SCM_SIMPLE_VECTOR_REF (signal_cell_handlers, signum);
SCM thread = SCM_VECTOR_REF(signal_handler_threads, signum); SCM thread = SCM_SIMPLE_VECTOR_REF (signal_handler_threads, signum);
scm_root_state *root = scm_i_thread_root (thread); scm_root_state *root = scm_i_thread_root (thread);
if (scm_is_pair (cell)) if (scm_is_pair (cell))
{ {
@ -183,15 +183,15 @@ really_install_handler (void *data)
*/ */
/* Make sure we have a cell. */ /* 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)) if (scm_is_false (cell))
{ {
cell = scm_cons (SCM_BOOL_F, SCM_EOL); 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. */ /* 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)) if (!scm_is_eq (thread, old_thread))
{ {
scm_root_state *r; scm_root_state *r;
@ -210,19 +210,19 @@ really_install_handler (void *data)
pending_asyncs of old_thread. */ pending_asyncs of old_thread. */
r->pending_asyncs = 1; 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. */ /* Set the new handler. */
if (scm_is_false (handler)) if (scm_is_false (handler))
{ {
SCM_VECTOR_SET (*signal_handlers, signum, SCM_BOOL_F); SCM_SIMPLE_VECTOR_SET (*signal_handlers, signum, SCM_BOOL_F);
SCM_VECTOR_SET (signal_cell_handlers, signum, SCM_BOOL_F); SCM_SIMPLE_VECTOR_SET (signal_cell_handlers, signum, SCM_BOOL_F);
} }
else else
{ {
SCM_VECTOR_SET (*signal_handlers, signum, handler); SCM_SIMPLE_VECTOR_SET (*signal_handlers, signum, handler);
SCM_VECTOR_SET (signal_cell_handlers, signum, SCM_SIMPLE_VECTOR_SET (signal_cell_handlers, signum,
close_1 (handler, scm_from_int (signum))); close_1 (handler, scm_from_int (signum)));
} }
@ -233,7 +233,7 @@ really_install_handler (void *data)
problem. problem.
*/ */
if (scm_is_true (SCM_CAR (cell))) 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. */ /* Phfew. That should be it. */
return NULL; return NULL;
@ -324,7 +324,7 @@ SCM_DEFINE (scm_sigaction_for_thread, "sigaction", 1, 3, 0,
} }
SCM_DEFER_INTS; SCM_DEFER_INTS;
old_handler = SCM_VECTOR_REF(*signal_handlers, csig); old_handler = SCM_SIMPLE_VECTOR_REF (*signal_handlers, csig);
if (SCM_UNBNDP (handler)) if (SCM_UNBNDP (handler))
query_only = 1; query_only = 1;
else if (scm_is_integer (handler)) 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) if (sigaction (i, &orig_handlers[i], NULL) == -1)
SCM_SYSERROR; SCM_SYSERROR;
orig_handlers[i].sa_handler = SIG_ERR; 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 #else
if (orig_handlers[i] != SIG_ERR) 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) if (signal (i, orig_handlers[i]) == SIG_ERR)
SCM_SYSERROR; SCM_SYSERROR;
orig_handlers[i] = SIG_ERR; 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 #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); result = scm_c_make_vector (3, SCM_UNSPECIFIED);
SCM_VECTOR_SET(result, 0, SCM_SIMPLE_VECTOR_SET(result, 0,
scm_from_short (fam)); 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_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))); scm_from_ushort (ntohs (nad->sin_port)));
} }
break; break;
@ -924,14 +924,14 @@ scm_addr_vector (const struct sockaddr *address, int addr_size,
const struct sockaddr_in6 *nad = (struct sockaddr_in6 *) address; const struct sockaddr_in6 *nad = (struct sockaddr_in6 *) address;
result = scm_c_make_vector (5, SCM_UNSPECIFIED); result = scm_c_make_vector (5, SCM_UNSPECIFIED);
SCM_VECTOR_SET(result, 0, scm_from_short (fam)); SCM_SIMPLE_VECTOR_SET(result, 0, scm_from_short (fam));
SCM_VECTOR_SET(result, 1, scm_from_ipv6 (nad->sin6_addr.s6_addr)); SCM_SIMPLE_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_SIMPLE_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, 3, scm_from_uint32 (nad->sin6_flowinfo));
#ifdef HAVE_SIN6_SCOPE_ID #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 #else
SCM_VECTOR_SET(result, 4, SCM_INUM0); SCM_SIMPLE_VECTOR_SET(result, 4, SCM_INUM0);
#endif #endif
} }
break; break;
@ -943,13 +943,13 @@ scm_addr_vector (const struct sockaddr *address, int addr_size,
result = scm_c_make_vector (2, SCM_UNSPECIFIED); 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 /* When addr_size is not enough to cover sun_path, do not try
to access it. */ to access it. */
if (addr_size <= offsetof (struct sockaddr_un, sun_path)) 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 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; break;
#endif #endif

70
libguile/stime.c
View file

@ -186,11 +186,11 @@ SCM_DEFINE (scm_times, "times", 0, 0, 0,
rv = times (&t); rv = times (&t);
if (rv == -1) if (rv == -1)
SCM_SYSERROR; SCM_SYSERROR;
SCM_VECTOR_SET (result, 0, scm_from_long (rv)); SCM_SIMPLE_VECTOR_SET (result, 0, scm_from_long (rv));
SCM_VECTOR_SET (result, 1, scm_from_long (t.tms_utime)); SCM_SIMPLE_VECTOR_SET (result, 1, scm_from_long (t.tms_utime));
SCM_VECTOR_SET (result, 2, scm_from_long (t.tms_stime)); SCM_SIMPLE_VECTOR_SET (result, 2, scm_from_long (t.tms_stime));
SCM_VECTOR_SET (result ,3, scm_from_long (t.tms_cutime)); SCM_SIMPLE_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, 4, scm_from_long (t.tms_cstime));
return result; return result;
} }
#undef FUNC_NAME #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 result = scm_c_make_vector (11, SCM_UNDEFINED);
SCM_VECTOR_SET (result,0, scm_from_int (bd_time->tm_sec)); SCM_SIMPLE_VECTOR_SET (result,0, scm_from_int (bd_time->tm_sec));
SCM_VECTOR_SET (result,1, scm_from_int (bd_time->tm_min)); SCM_SIMPLE_VECTOR_SET (result,1, scm_from_int (bd_time->tm_min));
SCM_VECTOR_SET (result,2, scm_from_int (bd_time->tm_hour)); SCM_SIMPLE_VECTOR_SET (result,2, scm_from_int (bd_time->tm_hour));
SCM_VECTOR_SET (result,3, scm_from_int (bd_time->tm_mday)); SCM_SIMPLE_VECTOR_SET (result,3, scm_from_int (bd_time->tm_mday));
SCM_VECTOR_SET (result,4, scm_from_int (bd_time->tm_mon)); SCM_SIMPLE_VECTOR_SET (result,4, scm_from_int (bd_time->tm_mon));
SCM_VECTOR_SET (result,5, scm_from_int (bd_time->tm_year)); SCM_SIMPLE_VECTOR_SET (result,5, scm_from_int (bd_time->tm_year));
SCM_VECTOR_SET (result,6, scm_from_int (bd_time->tm_wday)); SCM_SIMPLE_VECTOR_SET (result,6, scm_from_int (bd_time->tm_wday));
SCM_VECTOR_SET (result,7, scm_from_int (bd_time->tm_yday)); SCM_SIMPLE_VECTOR_SET (result,7, scm_from_int (bd_time->tm_yday));
SCM_VECTOR_SET (result,8, scm_from_int (bd_time->tm_isdst)); SCM_SIMPLE_VECTOR_SET (result,8, scm_from_int (bd_time->tm_isdst));
SCM_VECTOR_SET (result,9, scm_from_int (zoff)); SCM_SIMPLE_VECTOR_SET (result,9, scm_from_int (zoff));
SCM_VECTOR_SET (result,10, (zname SCM_SIMPLE_VECTOR_SET (result,10, (zname
? scm_from_locale_string (zname) ? scm_from_locale_string (zname)
: SCM_BOOL_F)); : SCM_BOOL_F));
return result; return result;
@ -483,35 +483,25 @@ SCM_DEFINE (scm_gmtime, "gmtime", 1, 0, 0,
static void static void
bdtime2c (SCM sbd_time, struct tm *lt, int pos, const char *subr) bdtime2c (SCM sbd_time, struct tm *lt, int pos, const char *subr)
{ {
SCM const *velts; SCM_ASSERT (scm_is_simple_vector (sbd_time)
int i; && SCM_SIMPLE_VECTOR_LENGTH (sbd_time) == 11,
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]),
sbd_time, pos, subr); sbd_time, pos, subr);
lt->tm_sec = scm_to_int (velts[0]); lt->tm_sec = scm_to_int (SCM_SIMPLE_VECTOR_REF (sbd_time, 0));
lt->tm_min = scm_to_int (velts[1]); lt->tm_min = scm_to_int (SCM_SIMPLE_VECTOR_REF (sbd_time, 1));
lt->tm_hour = scm_to_int (velts[2]); lt->tm_hour = scm_to_int (SCM_SIMPLE_VECTOR_REF (sbd_time, 2));
lt->tm_mday = scm_to_int (velts[3]); lt->tm_mday = scm_to_int (SCM_SIMPLE_VECTOR_REF (sbd_time, 3));
lt->tm_mon = scm_to_int (velts[4]); lt->tm_mon = scm_to_int (SCM_SIMPLE_VECTOR_REF (sbd_time, 4));
lt->tm_year = scm_to_int (velts[5]); lt->tm_year = scm_to_int (SCM_SIMPLE_VECTOR_REF (sbd_time, 5));
lt->tm_wday = scm_to_int (velts[6]); lt->tm_wday = scm_to_int (SCM_SIMPLE_VECTOR_REF (sbd_time, 6));
lt->tm_yday = scm_to_int (velts[7]); lt->tm_yday = scm_to_int (SCM_SIMPLE_VECTOR_REF (sbd_time, 7));
lt->tm_isdst = scm_to_int (velts[8]); lt->tm_isdst = scm_to_int (SCM_SIMPLE_VECTOR_REF (sbd_time, 8));
#ifdef HAVE_TM_ZONE #ifdef HAVE_TM_ZONE
lt->tm_gmtoff = scm_to_int (velts[9]); lt->tm_gmtoff = scm_to_int (SCM_SIMPLE_VECTOR_REF (sbd_time, 9));
if (scm_is_false (velts[10])) if (scm_is_false (SCM_SIMPLE_VECTOR_REF (sbd_time, 10)))
lt->tm_zone = NULL; lt->tm_zone = NULL;
else 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 #endif
} }

4
libguile/symbols.c
View file

@ -98,7 +98,7 @@ scm_i_mem2symbol (SCM str)
SCM l; SCM l;
for (l = SCM_HASHTABLE_BUCKETS (symbols) [hash]; for (l = SCM_HASHTABLE_BUCKET (symbols, hash);
!scm_is_null (l); !scm_is_null (l);
l = SCM_CDR (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 symbol = scm_i_make_symbol (str, 0, raw_hash,
scm_cons (SCM_BOOL_F, SCM_EOL)); 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 cell = scm_cons (symbol, SCM_UNDEFINED);
SCM_SET_HASHTABLE_BUCKET (symbols, hash, scm_cons (cell, slot)); SCM_SET_HASHTABLE_BUCKET (symbols, hash, scm_cons (cell, slot));
SCM_HASHTABLE_INCREMENT (symbols); 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 #define scm_tc7_pws 31
#if SCM_HAVE_ARRAYS
#define scm_tc7_unused_1 29 #define scm_tc7_unused_1 29
#define scm_tc7_unused_2 37 #define scm_tc7_unused_2 37
#define scm_tc7_unused_3 45 #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_7 71
#define scm_tc7_unused_8 77 #define scm_tc7_unused_8 77
#define scm_tc7_unused_9 79 #define scm_tc7_unused_9 79
#endif
#define scm_tc7_dsubr 61 #define scm_tc7_dsubr 61
#define scm_tc7_cclo 63 #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) if (pt->write_pos > pt->write_buf)
{ {
/* write the byte. */ /* 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; pt->write_pos = pt->write_buf;
/* flush the output. */ /* flush the output. */
{ {
SCM f = SCM_VELTS (stream)[2]; SCM f = SCM_SIMPLE_VECTOR_REF (stream, 2);
if (scm_is_true (f)) if (scm_is_true (f))
scm_call_0 (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 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, /* 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 p = SCM_PACK (SCM_STREAM (port));
SCM ans; 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)) if (scm_is_false (ans) || SCM_EOF_OBJECT_P (ans))
return EOF; return EOF;
SCM_ASSERT (SCM_CHARP (ans), ans, SCM_ARG1, "sf_fill_input"); SCM_ASSERT (SCM_CHARP (ans), ans, SCM_ARG1, "sf_fill_input");
@ -109,7 +111,7 @@ static int
sf_close (SCM port) sf_close (SCM port)
{ {
SCM p = SCM_PACK (SCM_STREAM (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)) if (scm_is_false (f))
return 0; return 0;
f = scm_call_0 (f); f = scm_call_0 (f);
@ -122,9 +124,9 @@ static int
sf_input_waiting (SCM port) sf_input_waiting (SCM port)
{ {
SCM p = SCM_PACK (SCM_STREAM (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)) if (scm_is_true (f))
return scm_to_int (scm_call_0 (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 z;
SCM_VALIDATE_VECTOR (1, pv); 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_ASSERT ((vlen == 5) || (vlen == 6), pv, 1, FUNC_NAME);
SCM_VALIDATE_STRING (2, modes); SCM_VALIDATE_STRING (2, modes);