summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--libguile/ChangeLog24
-rw-r--r--libguile/environments.c4
-rw-r--r--libguile/eval.c2
-rw-r--r--libguile/filesys.c2
-rw-r--r--libguile/fluids.c5
-rw-r--r--libguile/gc.c8
-rw-r--r--libguile/gh_data.c4
-rw-r--r--libguile/goops.c10
-rw-r--r--libguile/hashtab.c5
-rw-r--r--libguile/hashtab.h2
-rw-r--r--libguile/keywords.c4
-rw-r--r--libguile/net_db.c8
-rw-r--r--libguile/posix.c8
-rw-r--r--libguile/print.c5
-rw-r--r--libguile/regex-posix.c2
-rw-r--r--libguile/scmsigs.c3
-rw-r--r--libguile/socket.c4
-rw-r--r--libguile/stime.c4
-rw-r--r--libguile/symbols.c3
-rw-r--r--libguile/unif.c4
-rw-r--r--libguile/vectors.c26
-rw-r--r--libguile/vectors.h2
22 files changed, 87 insertions, 52 deletions
diff --git a/libguile/ChangeLog b/libguile/ChangeLog
index 89e41586b..d7d1e2b0d 100644
--- a/libguile/ChangeLog
+++ b/libguile/ChangeLog
@@ -1,3 +1,27 @@
+2001-02-01 Keisuke Nishida <kxn30@po.cwru.edu>
+
+ * vectors.c (scm_c_make_vector): New function.
+ * vectors.h (scm_c_make_vector): Declared.
+ * eval.c (scm_copy_tree), filesys.c (scm_stat2scm), fluids.c
+ (scm_make_initial_fluids, grow_fluids), gc.c (scm_init_storage),
+ gh_data.c (gh_ints2scm, gh_doubles2scm): goops.c
+ (scm_make_method_cache, scm_i_vector2list,
+ scm_compute_applicable_methods, scm_sys_method_more_specific_p),
+ init.c (start_stack), net_db.c (scm_gethost, scm_getnet,
+ scm_getproto, scm_return_entry), posix.c (scm_getgroups,
+ scm_getpwuid, scm_getgrgid, scm_uname), print.c (make_print_state,
+ grow_ref_stack), regex-posix.c (scm_regexp_exec), scmsigs.c
+ (scm_init_scmsigs), socket.c (scm_addr_vector, scm_addr_vector),
+ stime.c (scm_times, filltime), unif.c (scm_make_uve), vectors.c
+ (scm_vector, scm_make_vector): Use scm_c_make_vector.
+
+ * hashtab.c (scm_c_make_hash_table): New function.
+ * hashtab.h (scm_c_make_hash_table): Declared.
+ * environments.c (scm_make_leaf_environment,
+ scm_make_eval_environment), gc.c (scm_init_storage),
+ keywords.c (scm_init_keywords), symbols.c (scm_builtin_bindings):
+ Use scm_c_make_hash_table.
+
2001-01-31 Mikael Djurfeldt <mdj@linnaeus.mit.edu>
* unif.c (rapr1): Don't apply scm_uniform_vector_length on arrays.
diff --git a/libguile/environments.c b/libguile/environments.c
index 8e42afa58..710d29ad1 100644
--- a/libguile/environments.c
+++ b/libguile/environments.c
@@ -1032,7 +1032,7 @@ SCM_DEFINE (scm_make_leaf_environment, "make-leaf-environment", 0, 0, 0,
env = scm_make_environment (body);
core_environments_init (&body->base, &leaf_environment_funcs);
- body->obarray = scm_make_vector (SCM_MAKINUM (DEFAULT_OBARRAY_SIZE), SCM_EOL);
+ body->obarray = scm_c_make_hash_table (DEFAULT_OBARRAY_SIZE);
return env;
}
@@ -1424,7 +1424,7 @@ SCM_DEFINE (scm_make_eval_environment, "make-eval-environment", 2, 0, 0,
env = scm_make_environment (body);
core_environments_init (&body->base, &eval_environment_funcs);
- body->obarray = scm_make_vector (SCM_MAKINUM (DEFAULT_OBARRAY_SIZE), SCM_EOL);
+ body->obarray = scm_c_make_hash_table (DEFAULT_OBARRAY_SIZE);
body->imported = imported;
body->imported_observer
= SCM_ENVIRONMENT_OBSERVE (imported, eval_environment_observer, env, 1);
diff --git a/libguile/eval.c b/libguile/eval.c
index eaef7570e..b1cc84f96 100644
--- a/libguile/eval.c
+++ b/libguile/eval.c
@@ -3760,7 +3760,7 @@ SCM_DEFINE (scm_copy_tree, "copy-tree", 1, 0, 0,
if (SCM_VECTORP (obj))
{
scm_sizet i = SCM_VECTOR_LENGTH (obj);
- ans = scm_make_vector (SCM_MAKINUM (i), SCM_UNSPECIFIED);
+ ans = scm_c_make_vector (i, SCM_UNSPECIFIED);
while (i--)
SCM_VELTS (ans)[i] = scm_copy_tree (SCM_VELTS (obj)[i]);
return ans;
diff --git a/libguile/filesys.c b/libguile/filesys.c
index 1b4fe2b68..a809e7f36 100644
--- a/libguile/filesys.c
+++ b/libguile/filesys.c
@@ -373,7 +373,7 @@ SCM_SYMBOL (scm_sym_unknown, "unknown");
static SCM
scm_stat2scm (struct stat *stat_temp)
{
- SCM ans = scm_make_vector (SCM_MAKINUM (15), SCM_UNSPECIFIED);
+ SCM ans = scm_c_make_vector (15, SCM_UNSPECIFIED);
SCM *ve = SCM_VELTS (ans);
ve[0] = scm_ulong2num ((unsigned long) stat_temp->st_dev);
diff --git a/libguile/fluids.c b/libguile/fluids.c
index bcac1f824..a52b2c8df 100644
--- a/libguile/fluids.c
+++ b/libguile/fluids.c
@@ -61,8 +61,7 @@ scm_bits_t scm_tc16_fluid;
SCM
scm_make_initial_fluids ()
{
- return scm_make_vector (SCM_MAKINUM (INITIAL_FLUIDS),
- SCM_BOOL_F);
+ return scm_c_make_vector (INITIAL_FLUIDS, SCM_BOOL_F);
}
static void
@@ -73,7 +72,7 @@ grow_fluids (scm_root_state *root_state, int new_length)
old_fluids = root_state->fluids;
old_length = SCM_VECTOR_LENGTH (old_fluids);
- new_fluids = scm_make_vector (SCM_MAKINUM (new_length), SCM_BOOL_F);
+ new_fluids = scm_c_make_vector (new_length, SCM_BOOL_F);
i = 0;
while (i < old_length)
{
diff --git a/libguile/gc.c b/libguile/gc.c
index 5d4aa0063..0057ed372 100644
--- a/libguile/gc.c
+++ b/libguile/gc.c
@@ -2614,15 +2614,15 @@ scm_init_storage ()
scm_listofnull = scm_cons (SCM_EOL, SCM_EOL);
scm_nullstr = scm_makstr (0L, 0);
- scm_nullvect = scm_make_vector (SCM_INUM0, SCM_UNDEFINED);
+ scm_nullvect = scm_c_make_vector (0, SCM_UNDEFINED);
#define DEFAULT_SYMHASH_SIZE 277
- scm_symhash = scm_make_vector (SCM_MAKINUM (DEFAULT_SYMHASH_SIZE), SCM_EOL);
- scm_symhash_vars = scm_make_vector (SCM_MAKINUM (DEFAULT_SYMHASH_SIZE), SCM_EOL);
+ scm_symhash = scm_c_make_hash_table (DEFAULT_SYMHASH_SIZE);
+ scm_symhash_vars = scm_c_make_hash_table (DEFAULT_SYMHASH_SIZE);
scm_stand_in_procs = SCM_EOL;
scm_permobjs = SCM_EOL;
- scm_protects = scm_make_vector (SCM_MAKINUM (31), SCM_EOL);
+ scm_protects = scm_c_make_hash_table (31);
return 0;
}
diff --git a/libguile/gh_data.c b/libguile/gh_data.c
index 5597e9a88..6e7eab19c 100644
--- a/libguile/gh_data.c
+++ b/libguile/gh_data.c
@@ -136,7 +136,7 @@ SCM
gh_ints2scm (int *d, int n)
{
int i;
- SCM v = scm_make_vector(SCM_MAKINUM(n), SCM_UNSPECIFIED);
+ SCM v = scm_c_make_vector (n, SCM_UNSPECIFIED);
SCM *velts = SCM_VELTS(v);
for (i = 0; i < n; ++i)
@@ -149,7 +149,7 @@ SCM
gh_doubles2scm (const double *d, int n)
{
int i;
- SCM v = scm_make_vector(SCM_MAKINUM(n), SCM_UNSPECIFIED);
+ SCM v = scm_c_make_vector (n, SCM_UNSPECIFIED);
SCM *velts = SCM_VELTS(v);
for(i = 0; i < n; i++)
diff --git a/libguile/goops.c b/libguile/goops.c
index 07c494e25..9794aca6f 100644
--- a/libguile/goops.c
+++ b/libguile/goops.c
@@ -1537,8 +1537,8 @@ SCM
scm_make_method_cache (SCM gf)
{
return SCM_LIST5 (SCM_IM_DISPATCH, scm_sym_args, SCM_MAKINUM (1),
- scm_make_vector (SCM_MAKINUM (SCM_INITIAL_MCACHE_SIZE),
- list_of_no_method),
+ scm_c_make_vector (SCM_INITIAL_MCACHE_SIZE,
+ list_of_no_method),
gf);
}
@@ -1693,7 +1693,7 @@ static SCM
scm_i_vector2list (SCM l, int len)
{
int j;
- SCM z = scm_make_vector (SCM_MAKINUM (len), SCM_UNDEFINED);
+ SCM z = scm_c_make_vector (len, SCM_UNDEFINED);
for (j = 0; j < len; j++, l = SCM_CDR (l)) {
SCM_VELTS (z)[j] = SCM_CAR (l);
@@ -1777,7 +1777,7 @@ scm_compute_applicable_methods (SCM gf, SCM args, int len, int find_method_p)
/* Build the list of arguments types */
if (len >= BUFFSIZE) {
- tmp = scm_make_vector (SCM_MAKINUM (len), SCM_UNDEFINED);
+ 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. */
@@ -2087,7 +2087,7 @@ SCM_DEFINE (scm_sys_method_more_specific_p, "%method-more-specific?", 3, 0, 0,
SCM_ASSERT ((len = scm_ilength (targs)) != -1, targs, SCM_ARG3, FUNC_NAME);
/* Verify that all the arguments of targs are classes and place them in a vector*/
- v = scm_make_vector (SCM_MAKINUM (len), SCM_EOL);
+ v = scm_c_make_vector (len, SCM_EOL);
for (i=0, l=targs; SCM_NNULLP(l); i++, l=SCM_CDR(l)) {
SCM_ASSERT (SCM_CLASSP (SCM_CAR (l)), targs, SCM_ARG3, FUNC_NAME);
diff --git a/libguile/hashtab.c b/libguile/hashtab.c
index 1efb64781..1f001f236 100644
--- a/libguile/hashtab.c
+++ b/libguile/hashtab.c
@@ -55,6 +55,11 @@
#include "libguile/hashtab.h"
+SCM
+scm_c_make_hash_table (unsigned long k)
+{
+ return scm_c_make_vector (k, SCM_EOL);
+}
SCM
scm_hash_fn_get_handle (SCM table,SCM obj,unsigned int (*hash_fn)(),SCM (*assoc_fn)(),void * closure)
diff --git a/libguile/hashtab.h b/libguile/hashtab.h
index b05979a3a..ff79cc701 100644
--- a/libguile/hashtab.h
+++ b/libguile/hashtab.h
@@ -53,6 +53,8 @@ typedef SCM scm_assoc_fn_t (SCM key, SCM alist, void *closure);
typedef SCM scm_delete_fn_t (SCM elt, SCM list);
#endif
+extern SCM scm_c_make_hash_table (unsigned long k);
+
extern SCM scm_hash_fn_get_handle (SCM table, SCM obj, unsigned int (*hash_fn) (), SCM (*assoc_fn) (), void * closure);
extern SCM scm_hash_fn_create_handle_x (SCM table, SCM obj, SCM init, unsigned int (*hash_fn) (), SCM (*assoc_fn) (), void * closure);
extern SCM scm_hash_fn_ref (SCM table, SCM obj, SCM dflt, unsigned int (*hash_fn) (), SCM (*assoc_fn) (), void * closure);
diff --git a/libguile/keywords.c b/libguile/keywords.c
index 78563bc92..c979d4123 100644
--- a/libguile/keywords.c
+++ b/libguile/keywords.c
@@ -51,7 +51,7 @@
#include "libguile/ports.h"
#include "libguile/root.h"
#include "libguile/smob.h"
-#include "libguile/vectors.h"
+#include "libguile/hashtab.h"
#include "libguile/validate.h"
#include "libguile/keywords.h"
@@ -139,7 +139,7 @@ scm_init_keywords ()
scm_set_smob_mark (scm_tc16_keyword, scm_markcdr);
scm_set_smob_print (scm_tc16_keyword, keyword_print);
- scm_keyword_obarray = scm_make_vector (SCM_MAKINUM (256), SCM_EOL);
+ scm_keyword_obarray = scm_c_make_hash_table (256);
#ifndef SCM_MAGIC_SNARFER
#include "libguile/keywords.x"
#endif
diff --git a/libguile/net_db.c b/libguile/net_db.c
index 9e92c7071..19a826d09 100644
--- a/libguile/net_db.c
+++ b/libguile/net_db.c
@@ -251,7 +251,7 @@ SCM_DEFINE (scm_gethost, "gethost", 0, 1, 0,
"@code{system-error} or @code{misc_error} keys.")
#define FUNC_NAME s_scm_gethost
{
- SCM ans = scm_make_vector (SCM_MAKINUM (5), SCM_UNSPECIFIED);
+ SCM ans = scm_c_make_vector (5, SCM_UNSPECIFIED);
SCM *ve = SCM_VELTS (ans);
SCM lst = SCM_EOL;
struct hostent *entry;
@@ -336,7 +336,7 @@ SCM_DEFINE (scm_getnet, "getnet", 0, 1, 0,
SCM *ve;
struct netent *entry;
- ans = scm_make_vector (SCM_MAKINUM (4), SCM_UNSPECIFIED);
+ ans = scm_c_make_vector (4, SCM_UNSPECIFIED);
ve = SCM_VELTS (ans);
if (SCM_UNBNDP (net))
{
@@ -388,7 +388,7 @@ SCM_DEFINE (scm_getproto, "getproto", 0, 1, 0,
SCM *ve;
struct protoent *entry;
- ans = scm_make_vector (SCM_MAKINUM (3), SCM_UNSPECIFIED);
+ ans = scm_c_make_vector (3, SCM_UNSPECIFIED);
ve = SCM_VELTS (ans);
if (SCM_UNBNDP (protocol))
{
@@ -430,7 +430,7 @@ scm_return_entry (struct servent *entry)
SCM ans;
SCM *ve;
- ans = scm_make_vector (SCM_MAKINUM (4), SCM_UNSPECIFIED);
+ ans = scm_c_make_vector (4, SCM_UNSPECIFIED);
ve = SCM_VELTS (ans);
ve[0] = scm_makfromstr (entry->s_name, (scm_sizet) strlen (entry->s_name), 0);
ve[1] = scm_makfromstrs (-1, entry->s_aliases);
diff --git a/libguile/posix.c b/libguile/posix.c
index b766cb4c1..c85ec6c28 100644
--- a/libguile/posix.c
+++ b/libguile/posix.c
@@ -217,7 +217,7 @@ SCM_DEFINE (scm_getgroups, "getgroups", 0, 0, 0,
groups = scm_must_malloc (size, FUNC_NAME);
getgroups (ngroups, groups);
- ans = scm_make_vector (SCM_MAKINUM (ngroups), SCM_UNDEFINED);
+ ans = scm_c_make_vector (ngroups, SCM_UNDEFINED);
while (--ngroups >= 0)
SCM_VELTS (ans) [ngroups] = SCM_MAKINUM (groups [ngroups]);
@@ -241,7 +241,7 @@ SCM_DEFINE (scm_getpwuid, "getpw", 0, 1, 0,
struct passwd *entry;
SCM *ve;
- result = scm_make_vector (SCM_MAKINUM (7), SCM_UNSPECIFIED);
+ result = scm_c_make_vector (7, SCM_UNSPECIFIED);
ve = SCM_VELTS (result);
if (SCM_UNBNDP (user) || SCM_FALSEP (user))
{
@@ -312,7 +312,7 @@ SCM_DEFINE (scm_getgrgid, "getgr", 0, 1, 0,
SCM result;
struct group *entry;
SCM *ve;
- result = scm_make_vector (SCM_MAKINUM (4), SCM_UNSPECIFIED);
+ result = scm_c_make_vector (4, SCM_UNSPECIFIED);
ve = SCM_VELTS (result);
if (SCM_UNBNDP (name) || SCM_FALSEP (name))
{
@@ -952,7 +952,7 @@ SCM_DEFINE (scm_uname, "uname", 0, 0, 0,
#define FUNC_NAME s_scm_uname
{
struct utsname buf;
- SCM ans = scm_make_vector (SCM_MAKINUM(5), SCM_UNSPECIFIED);
+ SCM ans = scm_c_make_vector (5, SCM_UNSPECIFIED);
SCM *ve = SCM_VELTS (ans);
if (uname (&buf) < 0)
SCM_SYSERROR;
diff --git a/libguile/print.c b/libguile/print.c
index 0dc7b82ff..c7fa4b157 100644
--- a/libguile/print.c
+++ b/libguile/print.c
@@ -212,8 +212,7 @@ make_print_state (void)
SCM_INUM0,
SCM_EOL);
scm_print_state *pstate = SCM_PRINT_STATE (print_state);
- pstate->ref_vect = scm_make_vector (SCM_MAKINUM (PSTATE_SIZE),
- SCM_UNDEFINED);
+ pstate->ref_vect = scm_c_make_vector (PSTATE_SIZE, SCM_UNDEFINED);
pstate->ref_stack = SCM_VELTS (pstate->ref_vect);
pstate->ceiling = SCM_VECTOR_LENGTH (pstate->ref_vect);
return print_state;
@@ -262,7 +261,7 @@ grow_ref_stack (scm_print_state *pstate)
unsigned long int old_size = SCM_VECTOR_LENGTH (pstate->ref_vect);
SCM *old_elts = SCM_VELTS (pstate->ref_vect);
unsigned long int new_size = 2 * pstate->ceiling;
- SCM new_vect = scm_make_vector (SCM_MAKINUM (new_size), SCM_UNDEFINED);
+ SCM new_vect = scm_c_make_vector (new_size, SCM_UNDEFINED);
SCM *new_elts = SCM_VELTS (new_vect);
unsigned long int i;
diff --git a/libguile/regex-posix.c b/libguile/regex-posix.c
index 0abb4b8da..da18e9119 100644
--- a/libguile/regex-posix.c
+++ b/libguile/regex-posix.c
@@ -254,7 +254,7 @@ SCM_DEFINE (scm_regexp_exec, "regexp-exec", 2, 2, 0,
int i;
/* The match vector must include a cell for the string that was matched,
so add 1. */
- mvec = scm_make_vector (SCM_MAKINUM (nmatches + 1), SCM_UNSPECIFIED);
+ mvec = scm_c_make_vector (nmatches + 1, SCM_UNSPECIFIED);
SCM_VELTS(mvec)[0] = str;
for (i = 0; i < nmatches; ++i)
if (matches[i].rm_so == -1)
diff --git a/libguile/scmsigs.c b/libguile/scmsigs.c
index 795367a29..415169915 100644
--- a/libguile/scmsigs.c
+++ b/libguile/scmsigs.c
@@ -493,8 +493,7 @@ scm_init_scmsigs ()
signal_handlers =
SCM_CDRLOC (scm_sysintern ("signal-handlers",
- scm_make_vector (SCM_MAKINUM (NSIG),
- SCM_BOOL_F)));
+ scm_c_make_vector (NSIG, SCM_BOOL_F)));
thunk = scm_make_gsubr ("%deliver-signals", 0, 0, 0,
sys_deliver_signals);
signal_async = scm_system_async (thunk);
diff --git a/libguile/socket.c b/libguile/socket.c
index fc306a321..d765383a2 100644
--- a/libguile/socket.c
+++ b/libguile/socket.c
@@ -555,7 +555,7 @@ scm_addr_vector (struct sockaddr *address,const char *proc)
if (fam == AF_UNIX)
{
struct sockaddr_un *nad = (struct sockaddr_un *) address;
- result = scm_make_vector (SCM_MAKINUM (2), SCM_UNSPECIFIED);
+ result = scm_c_make_vector (2, SCM_UNSPECIFIED);
ve = SCM_VELTS (result);
ve[0] = scm_ulong2num ((unsigned long) fam);
ve[1] = scm_makfromstr (nad->sun_path,
@@ -566,7 +566,7 @@ scm_addr_vector (struct sockaddr *address,const char *proc)
if (fam == AF_INET)
{
struct sockaddr_in *nad = (struct sockaddr_in *) address;
- result = scm_make_vector (SCM_MAKINUM (3), SCM_UNSPECIFIED);
+ result = scm_c_make_vector (3, SCM_UNSPECIFIED);
ve = SCM_VELTS (result);
ve[0] = scm_ulong2num ((unsigned long) fam);
ve[1] = scm_ulong2num (ntohl (nad->sin_addr.s_addr));
diff --git a/libguile/stime.c b/libguile/stime.c
index e5a524fcb..cb5b75822 100644
--- a/libguile/stime.c
+++ b/libguile/stime.c
@@ -186,7 +186,7 @@ SCM_DEFINE (scm_times, "times", 0, 0, 0,
struct tms t;
clock_t rv;
- SCM result = scm_make_vector (SCM_MAKINUM(5), SCM_UNDEFINED);
+ SCM result = scm_c_make_vector (5, SCM_UNDEFINED);
rv = times (&t);
if (rv == -1)
SCM_SYSERROR;
@@ -273,7 +273,7 @@ SCM_DEFINE (scm_gettimeofday, "gettimeofday", 0, 0, 0,
static SCM
filltime (struct tm *bd_time, int zoff, char *zname)
{
- SCM result = scm_make_vector (SCM_MAKINUM(11), SCM_UNDEFINED);
+ SCM result = scm_c_make_vector (11, SCM_UNDEFINED);
SCM_VELTS (result)[0] = SCM_MAKINUM (bd_time->tm_sec);
SCM_VELTS (result)[1] = SCM_MAKINUM (bd_time->tm_min);
diff --git a/libguile/symbols.c b/libguile/symbols.c
index a212b3126..4477bd683 100644
--- a/libguile/symbols.c
+++ b/libguile/symbols.c
@@ -55,6 +55,7 @@
#include "libguile/fluids.h"
#include "libguile/strings.h"
#include "libguile/vectors.h"
+#include "libguile/hashtab.h"
#include "libguile/weaks.h"
#include "libguile/modules.h"
@@ -759,7 +760,7 @@ SCM_DEFINE (scm_builtin_bindings, "builtin-bindings", 0, 0, 0,
#define FUNC_NAME s_scm_builtin_bindings
{
int length = SCM_VECTOR_LENGTH (scm_symhash);
- SCM obarray = scm_make_vector (SCM_MAKINUM (length), SCM_EOL);
+ SCM obarray = scm_c_make_hash_table (length);
copy_and_prune_obarray (scm_symhash, obarray);
return obarray;
}
diff --git a/libguile/unif.c b/libguile/unif.c
index 0eef7cfc4..889189ea7 100644
--- a/libguile/unif.c
+++ b/libguile/unif.c
@@ -212,13 +212,13 @@ scm_make_uve (long k, SCM prot)
#endif
else
{
- return scm_make_vector (SCM_MAKINUM (k), SCM_UNDEFINED);
+ return scm_c_make_vector (k, SCM_UNDEFINED);
}
}
else if (!SCM_INEXACTP (prot))
/* Huge non-unif vectors are NOT supported. */
/* no special scm_vector */
- return scm_make_vector (SCM_MAKINUM (k), SCM_UNDEFINED);
+ return scm_c_make_vector (k, SCM_UNDEFINED);
else if (singp (prot))
{
i = sizeof (float) * k;
diff --git a/libguile/vectors.c b/libguile/vectors.c
index 3848a8bbb..292252ebd 100644
--- a/libguile/vectors.c
+++ b/libguile/vectors.c
@@ -184,7 +184,7 @@ SCM_DEFINE (scm_vector, "vector", 0, 0, 1,
register SCM *data;
int i;
SCM_VALIDATE_LIST_COPYLEN (1,l,i);
- res = scm_make_vector (SCM_MAKINUM (i), SCM_UNSPECIFIED);
+ res = scm_c_make_vector (i, SCM_UNSPECIFIED);
data = SCM_VELTS (res);
for(; i && SCM_NIMP(l); --i, l = SCM_CDR (l))
*data++ = SCM_CAR (l);
@@ -270,30 +270,35 @@ SCM_DEFINE (scm_make_vector, "make-vector", 1, 1, 0,
"Otherwise the initial contents of each element is unspecified. (r5rs)")
#define FUNC_NAME s_scm_make_vector
{
- SCM v;
- unsigned long int i;
- scm_bits_t *velts;
-
SCM_VALIDATE_INUM_MIN (1, k, 0);
if (SCM_UNBNDP (fill))
fill = SCM_UNSPECIFIED;
+ return scm_c_make_vector (SCM_INUM (k), fill);
+}
+#undef FUNC_NAME
+
+SCM
+scm_c_make_vector (unsigned long int k, SCM fill)
+#define FUNC_NAME s_scm_make_vector
+{
+ SCM v;
+ scm_bits_t *velts;
- i = SCM_INUM (k);
SCM_NEWCELL (v);
- velts = (i != 0)
- ? scm_must_malloc (i * sizeof (scm_bits_t), FUNC_NAME)
+ velts = (k != 0)
+ ? scm_must_malloc (k * sizeof (scm_bits_t), FUNC_NAME)
: NULL;
SCM_DEFER_INTS;
{
unsigned long int j;
- for (j = 0; j != i; ++j)
+ for (j = 0; j != k; ++j)
velts[j] = SCM_UNPACK (fill);
SCM_SET_VECTOR_BASE (v, velts);
- SCM_SET_VECTOR_LENGTH (v, i, scm_tc7_vector);
+ SCM_SET_VECTOR_LENGTH (v, k, scm_tc7_vector);
}
SCM_ALLOW_INTS;
@@ -301,7 +306,6 @@ SCM_DEFINE (scm_make_vector, "make-vector", 1, 1, 0,
}
#undef FUNC_NAME
-
SCM_DEFINE (scm_vector_to_list, "vector->list", 1, 0, 0,
(SCM v),
"@samp{Vector->list} returns a newly allocated list of the objects contained\n"
diff --git a/libguile/vectors.h b/libguile/vectors.h
index 69616f0ca..f8449a714 100644
--- a/libguile/vectors.h
+++ b/libguile/vectors.h
@@ -73,6 +73,8 @@
+extern SCM scm_c_make_vector (unsigned long int k, SCM fill);
+
extern SCM scm_vector_p (SCM x);
extern SCM scm_vector_length (SCM v);
extern SCM scm_vector (SCM l);