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