mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-20 11:40:18 +02:00
Code Activity

New functions: scm_c_make_vector, scm_c_make_hash_table.

Browse source
This commit is contained in:
Keisuke Nishida 2001-02-02 04:56:25 +00:00
parent b8446ce883
commit 00ffa0e7d6
22 changed files with 87 additions and 52 deletions
Download patch file Download diff file Expand all files Collapse all files

24
libguile/ChangeLog
View file

@ -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> 2001-01-31 Mikael Djurfeldt <mdj@linnaeus.mit.edu>
* unif.c (rapr1): Don't apply scm_uniform_vector_length on arrays. * unif.c (rapr1): Don't apply scm_uniform_vector_length on arrays.

4
libguile/environments.c
View file

@ -1032,7 +1032,7 @@ SCM_DEFINE (scm_make_leaf_environment, "make-leaf-environment", 0, 0, 0,
env = scm_make_environment (body); env = scm_make_environment (body);
core_environments_init (&body->base, &leaf_environment_funcs); 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; return env;
} }
@ -1424,7 +1424,7 @@ SCM_DEFINE (scm_make_eval_environment, "make-eval-environment", 2, 0, 0,
env = scm_make_environment (body); env = scm_make_environment (body);
core_environments_init (&body->base, &eval_environment_funcs); 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 = imported;
body->imported_observer body->imported_observer
= SCM_ENVIRONMENT_OBSERVE (imported, eval_environment_observer, env, 1); = SCM_ENVIRONMENT_OBSERVE (imported, eval_environment_observer, env, 1);

2
libguile/eval.c
View file

@ -3760,7 +3760,7 @@ SCM_DEFINE (scm_copy_tree, "copy-tree", 1, 0, 0,
if (SCM_VECTORP (obj)) if (SCM_VECTORP (obj))
{ {
scm_sizet i = SCM_VECTOR_LENGTH (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--) while (i--)
SCM_VELTS (ans)[i] = scm_copy_tree (SCM_VELTS (obj)[i]); SCM_VELTS (ans)[i] = scm_copy_tree (SCM_VELTS (obj)[i]);
return ans; return ans;

2
libguile/filesys.c
View file

@ -373,7 +373,7 @@ SCM_SYMBOL (scm_sym_unknown, "unknown");
static SCM static SCM
scm_stat2scm (struct stat *stat_temp) 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); SCM *ve = SCM_VELTS (ans);
ve[0] = scm_ulong2num ((unsigned long) stat_temp->st_dev); ve[0] = scm_ulong2num ((unsigned long) stat_temp->st_dev);

5
libguile/fluids.c
View file

@ -61,8 +61,7 @@ scm_bits_t scm_tc16_fluid;
SCM SCM
scm_make_initial_fluids () scm_make_initial_fluids ()
{ {
return scm_make_vector (SCM_MAKINUM (INITIAL_FLUIDS), return scm_c_make_vector (INITIAL_FLUIDS, SCM_BOOL_F);
SCM_BOOL_F);
} }
static void static void
@ -73,7 +72,7 @@ grow_fluids (scm_root_state *root_state, int new_length)
old_fluids = root_state->fluids; old_fluids = root_state->fluids;
old_length = SCM_VECTOR_LENGTH (old_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; i = 0;
while (i < old_length) while (i < old_length)
{ {

8
libguile/gc.c
View file

@ -2614,15 +2614,15 @@ scm_init_storage ()
scm_listofnull = scm_cons (SCM_EOL, SCM_EOL); scm_listofnull = scm_cons (SCM_EOL, SCM_EOL);
scm_nullstr = scm_makstr (0L, 0); 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 #define DEFAULT_SYMHASH_SIZE 277
scm_symhash = scm_make_vector (SCM_MAKINUM (DEFAULT_SYMHASH_SIZE), SCM_EOL); scm_symhash = scm_c_make_hash_table (DEFAULT_SYMHASH_SIZE);
scm_symhash_vars = scm_make_vector (SCM_MAKINUM (DEFAULT_SYMHASH_SIZE), SCM_EOL); scm_symhash_vars = scm_c_make_hash_table (DEFAULT_SYMHASH_SIZE);
scm_stand_in_procs = SCM_EOL; scm_stand_in_procs = SCM_EOL;
scm_permobjs = 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; return 0;
} }

4
libguile/gh_data.c
View file

@ -136,7 +136,7 @@ SCM
gh_ints2scm (int *d, int n) gh_ints2scm (int *d, int n)
{ {
int i; 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); SCM *velts = SCM_VELTS(v);
for (i = 0; i < n; ++i) for (i = 0; i < n; ++i)
@ -149,7 +149,7 @@ SCM
gh_doubles2scm (const double *d, int n) gh_doubles2scm (const double *d, int n)
{ {
int i; 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); SCM *velts = SCM_VELTS(v);
for(i = 0; i < n; i++) for(i = 0; i < n; i++)

10
libguile/goops.c
View file

@ -1537,8 +1537,8 @@ SCM
scm_make_method_cache (SCM gf) scm_make_method_cache (SCM gf)
{ {
return SCM_LIST5 (SCM_IM_DISPATCH, scm_sym_args, SCM_MAKINUM (1), return SCM_LIST5 (SCM_IM_DISPATCH, scm_sym_args, SCM_MAKINUM (1),
scm_make_vector (SCM_MAKINUM (SCM_INITIAL_MCACHE_SIZE), scm_c_make_vector (SCM_INITIAL_MCACHE_SIZE,
list_of_no_method), list_of_no_method),
gf); gf);
} }
@ -1693,7 +1693,7 @@ static SCM
scm_i_vector2list (SCM l, int len) scm_i_vector2list (SCM l, int len)
{ {
int j; 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)) { for (j = 0; j < len; j++, l = SCM_CDR (l)) {
SCM_VELTS (z)[j] = SCM_CAR (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 */ /* Build the list of arguments types */
if (len >= BUFFSIZE) { 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 /* NOTE: Using pointers to malloced memory won't work if we
1. have preemtive threading, and, 1. have preemtive threading, and,
2. have a GC which moves objects. */ 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); 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_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)) { 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); SCM_ASSERT (SCM_CLASSP (SCM_CAR (l)), targs, SCM_ARG3, FUNC_NAME);

5
libguile/hashtab.c
View file

@ -55,6 +55,11 @@
#include "libguile/hashtab.h" #include "libguile/hashtab.h"
SCM
scm_c_make_hash_table (unsigned long k)
{
return scm_c_make_vector (k, SCM_EOL);
}
SCM SCM
scm_hash_fn_get_handle (SCM table,SCM obj,unsigned int (*hash_fn)(),SCM (*assoc_fn)(),void * closure) scm_hash_fn_get_handle (SCM table,SCM obj,unsigned int (*hash_fn)(),SCM (*assoc_fn)(),void * closure)

2
libguile/hashtab.h
View file

@ -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); typedef SCM scm_delete_fn_t (SCM elt, SCM list);
#endif #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_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_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); extern SCM scm_hash_fn_ref (SCM table, SCM obj, SCM dflt, unsigned int (*hash_fn) (), SCM (*assoc_fn) (), void * closure);

4
libguile/keywords.c
View file

@ -51,7 +51,7 @@
#include "libguile/ports.h" #include "libguile/ports.h"
#include "libguile/root.h" #include "libguile/root.h"
#include "libguile/smob.h" #include "libguile/smob.h"
#include "libguile/vectors.h" #include "libguile/hashtab.h"
#include "libguile/validate.h" #include "libguile/validate.h"
#include "libguile/keywords.h" #include "libguile/keywords.h"
@ -139,7 +139,7 @@ scm_init_keywords ()
scm_set_smob_mark (scm_tc16_keyword, scm_markcdr); scm_set_smob_mark (scm_tc16_keyword, scm_markcdr);
scm_set_smob_print (scm_tc16_keyword, keyword_print); 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 #ifndef SCM_MAGIC_SNARFER
#include "libguile/keywords.x" #include "libguile/keywords.x"
#endif #endif

8
libguile/net_db.c
View file

@ -251,7 +251,7 @@ SCM_DEFINE (scm_gethost, "gethost", 0, 1, 0,
"@code{system-error} or @code{misc_error} keys.") "@code{system-error} or @code{misc_error} keys.")
#define FUNC_NAME s_scm_gethost #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 *ve = SCM_VELTS (ans);
SCM lst = SCM_EOL; SCM lst = SCM_EOL;
struct hostent *entry; struct hostent *entry;
@ -336,7 +336,7 @@ SCM_DEFINE (scm_getnet, "getnet", 0, 1, 0,
SCM *ve; SCM *ve;
struct netent *entry; struct netent *entry;
ans = scm_make_vector (SCM_MAKINUM (4), SCM_UNSPECIFIED); ans = scm_c_make_vector (4, SCM_UNSPECIFIED);
ve = SCM_VELTS (ans); ve = SCM_VELTS (ans);
if (SCM_UNBNDP (net)) if (SCM_UNBNDP (net))
{ {
@ -388,7 +388,7 @@ SCM_DEFINE (scm_getproto, "getproto", 0, 1, 0,
SCM *ve; SCM *ve;
struct protoent *entry; struct protoent *entry;
ans = scm_make_vector (SCM_MAKINUM (3), SCM_UNSPECIFIED); ans = scm_c_make_vector (3, SCM_UNSPECIFIED);
ve = SCM_VELTS (ans); ve = SCM_VELTS (ans);
if (SCM_UNBNDP (protocol)) if (SCM_UNBNDP (protocol))
{ {
@ -430,7 +430,7 @@ scm_return_entry (struct servent *entry)
SCM ans; SCM ans;
SCM *ve; SCM *ve;
ans = scm_make_vector (SCM_MAKINUM (4), SCM_UNSPECIFIED); ans = scm_c_make_vector (4, SCM_UNSPECIFIED);
ve = SCM_VELTS (ans); ve = SCM_VELTS (ans);
ve[0] = scm_makfromstr (entry->s_name, (scm_sizet) strlen (entry->s_name), 0); ve[0] = scm_makfromstr (entry->s_name, (scm_sizet) strlen (entry->s_name), 0);
ve[1] = scm_makfromstrs (-1, entry->s_aliases); ve[1] = scm_makfromstrs (-1, entry->s_aliases);

8
libguile/posix.c
View file

@ -217,7 +217,7 @@ SCM_DEFINE (scm_getgroups, "getgroups", 0, 0, 0,
groups = scm_must_malloc (size, FUNC_NAME); groups = scm_must_malloc (size, FUNC_NAME);
getgroups (ngroups, groups); getgroups (ngroups, groups);
ans = scm_make_vector (SCM_MAKINUM (ngroups), SCM_UNDEFINED); ans = scm_c_make_vector (ngroups, SCM_UNDEFINED);
while (--ngroups >= 0) while (--ngroups >= 0)
SCM_VELTS (ans) [ngroups] = SCM_MAKINUM (groups [ngroups]); SCM_VELTS (ans) [ngroups] = SCM_MAKINUM (groups [ngroups]);
@ -241,7 +241,7 @@ SCM_DEFINE (scm_getpwuid, "getpw", 0, 1, 0,
struct passwd *entry; struct passwd *entry;
SCM *ve; SCM *ve;
result = scm_make_vector (SCM_MAKINUM (7), SCM_UNSPECIFIED); result = scm_c_make_vector (7, SCM_UNSPECIFIED);
ve = SCM_VELTS (result); ve = SCM_VELTS (result);
if (SCM_UNBNDP (user) || SCM_FALSEP (user)) if (SCM_UNBNDP (user) || SCM_FALSEP (user))
{ {
@ -312,7 +312,7 @@ SCM_DEFINE (scm_getgrgid, "getgr", 0, 1, 0,
SCM result; SCM result;
struct group *entry; struct group *entry;
SCM *ve; SCM *ve;
result = scm_make_vector (SCM_MAKINUM (4), SCM_UNSPECIFIED); result = scm_c_make_vector (4, SCM_UNSPECIFIED);
ve = SCM_VELTS (result); ve = SCM_VELTS (result);
if (SCM_UNBNDP (name) || SCM_FALSEP (name)) 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 #define FUNC_NAME s_scm_uname
{ {
struct utsname buf; 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); SCM *ve = SCM_VELTS (ans);
if (uname (&buf) < 0) if (uname (&buf) < 0)
SCM_SYSERROR; SCM_SYSERROR;

5
libguile/print.c
View file

@ -212,8 +212,7 @@ make_print_state (void)
SCM_INUM0, SCM_INUM0,
SCM_EOL); SCM_EOL);
scm_print_state *pstate = SCM_PRINT_STATE (print_state); scm_print_state *pstate = SCM_PRINT_STATE (print_state);
pstate->ref_vect = scm_make_vector (SCM_MAKINUM (PSTATE_SIZE), pstate->ref_vect = scm_c_make_vector (PSTATE_SIZE, SCM_UNDEFINED);
SCM_UNDEFINED);
pstate->ref_stack = SCM_VELTS (pstate->ref_vect); pstate->ref_stack = SCM_VELTS (pstate->ref_vect);
pstate->ceiling = SCM_VECTOR_LENGTH (pstate->ref_vect); pstate->ceiling = SCM_VECTOR_LENGTH (pstate->ref_vect);
return print_state; 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); unsigned long int old_size = SCM_VECTOR_LENGTH (pstate->ref_vect);
SCM *old_elts = SCM_VELTS (pstate->ref_vect); SCM *old_elts = SCM_VELTS (pstate->ref_vect);
unsigned long int new_size = 2 * pstate->ceiling; 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); SCM *new_elts = SCM_VELTS (new_vect);
unsigned long int i; unsigned long int i;

2
libguile/regex-posix.c
View file

@ -254,7 +254,7 @@ SCM_DEFINE (scm_regexp_exec, "regexp-exec", 2, 2, 0,
int i; int i;
/* 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_make_vector (SCM_MAKINUM (nmatches + 1), SCM_UNSPECIFIED); mvec = scm_c_make_vector (nmatches + 1, SCM_UNSPECIFIED);
SCM_VELTS(mvec)[0] = str; SCM_VELTS(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)

3
libguile/scmsigs.c
View file

@ -493,8 +493,7 @@ scm_init_scmsigs ()
signal_handlers = signal_handlers =
SCM_CDRLOC (scm_sysintern ("signal-handlers", SCM_CDRLOC (scm_sysintern ("signal-handlers",
scm_make_vector (SCM_MAKINUM (NSIG), scm_c_make_vector (NSIG, SCM_BOOL_F)));
SCM_BOOL_F)));
thunk = scm_make_gsubr ("%deliver-signals", 0, 0, 0, thunk = scm_make_gsubr ("%deliver-signals", 0, 0, 0,
sys_deliver_signals); sys_deliver_signals);
signal_async = scm_system_async (thunk); signal_async = scm_system_async (thunk);

4
libguile/socket.c
View file

@ -555,7 +555,7 @@ scm_addr_vector (struct sockaddr *address,const char *proc)
if (fam == AF_UNIX) if (fam == AF_UNIX)
{ {
struct sockaddr_un *nad = (struct sockaddr_un *) address; 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 = SCM_VELTS (result);
ve[0] = scm_ulong2num ((unsigned long) fam); ve[0] = scm_ulong2num ((unsigned long) fam);
ve[1] = scm_makfromstr (nad->sun_path, ve[1] = scm_makfromstr (nad->sun_path,
@ -566,7 +566,7 @@ scm_addr_vector (struct sockaddr *address,const char *proc)
if (fam == AF_INET) if (fam == AF_INET)
{ {
struct sockaddr_in *nad = (struct sockaddr_in *) address; 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 = SCM_VELTS (result);
ve[0] = scm_ulong2num ((unsigned long) fam); ve[0] = scm_ulong2num ((unsigned long) fam);
ve[1] = scm_ulong2num (ntohl (nad->sin_addr.s_addr)); ve[1] = scm_ulong2num (ntohl (nad->sin_addr.s_addr));

4
libguile/stime.c
View file

@ -186,7 +186,7 @@ SCM_DEFINE (scm_times, "times", 0, 0, 0,
struct tms t; struct tms t;
clock_t rv; 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); rv = times (&t);
if (rv == -1) if (rv == -1)
SCM_SYSERROR; SCM_SYSERROR;
@ -273,7 +273,7 @@ SCM_DEFINE (scm_gettimeofday, "gettimeofday", 0, 0, 0,
static SCM static SCM
filltime (struct tm *bd_time, int zoff, char *zname) 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)[0] = SCM_MAKINUM (bd_time->tm_sec);
SCM_VELTS (result)[1] = SCM_MAKINUM (bd_time->tm_min); SCM_VELTS (result)[1] = SCM_MAKINUM (bd_time->tm_min);

3
libguile/symbols.c
View file

@ -55,6 +55,7 @@
#include "libguile/fluids.h" #include "libguile/fluids.h"
#include "libguile/strings.h" #include "libguile/strings.h"
#include "libguile/vectors.h" #include "libguile/vectors.h"
#include "libguile/hashtab.h"
#include "libguile/weaks.h" #include "libguile/weaks.h"
#include "libguile/modules.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 #define FUNC_NAME s_scm_builtin_bindings
{ {
int length = SCM_VECTOR_LENGTH (scm_symhash); 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); copy_and_prune_obarray (scm_symhash, obarray);
return obarray; return obarray;
} }

4
libguile/unif.c
View file

@ -212,13 +212,13 @@ scm_make_uve (long k, SCM prot)
#endif #endif
else else
{ {
return scm_make_vector (SCM_MAKINUM (k), SCM_UNDEFINED); return scm_c_make_vector (k, SCM_UNDEFINED);
} }
} }
else if (!SCM_INEXACTP (prot)) else if (!SCM_INEXACTP (prot))
/* Huge non-unif vectors are NOT supported. */ /* Huge non-unif vectors are NOT supported. */
/* no special scm_vector */ /* 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)) else if (singp (prot))
{ {
i = sizeof (float) * k; i = sizeof (float) * k;

26
libguile/vectors.c
View file

@ -184,7 +184,7 @@ SCM_DEFINE (scm_vector, "vector", 0, 0, 1,
register SCM *data; register SCM *data;
int i; int i;
SCM_VALIDATE_LIST_COPYLEN (1,l,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); data = SCM_VELTS (res);
for(; i && SCM_NIMP(l); --i, l = SCM_CDR (l)) for(; i && SCM_NIMP(l); --i, l = SCM_CDR (l))
*data++ = SCM_CAR (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)") "Otherwise the initial contents of each element is unspecified. (r5rs)")
#define FUNC_NAME s_scm_make_vector #define FUNC_NAME s_scm_make_vector
{ {
SCM v;
unsigned long int i;
scm_bits_t *velts;
SCM_VALIDATE_INUM_MIN (1, k, 0); SCM_VALIDATE_INUM_MIN (1, k, 0);
if (SCM_UNBNDP (fill)) if (SCM_UNBNDP (fill))
fill = SCM_UNSPECIFIED; 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); SCM_NEWCELL (v);
velts = (i != 0) velts = (k != 0)
? scm_must_malloc (i * sizeof (scm_bits_t), FUNC_NAME) ? scm_must_malloc (k * sizeof (scm_bits_t), FUNC_NAME)
: NULL; : NULL;
SCM_DEFER_INTS; SCM_DEFER_INTS;
{ {
unsigned long int j; unsigned long int j;
for (j = 0; j != i; ++j) for (j = 0; j != k; ++j)
velts[j] = SCM_UNPACK (fill); velts[j] = SCM_UNPACK (fill);
SCM_SET_VECTOR_BASE (v, velts); 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; SCM_ALLOW_INTS;
@ -301,7 +306,6 @@ SCM_DEFINE (scm_make_vector, "make-vector", 1, 1, 0,
} }
#undef FUNC_NAME #undef FUNC_NAME
SCM_DEFINE (scm_vector_to_list, "vector->list", 1, 0, 0, SCM_DEFINE (scm_vector_to_list, "vector->list", 1, 0, 0,
(SCM v), (SCM v),
"@samp{Vector->list} returns a newly allocated list of the objects contained\n" "@samp{Vector->list} returns a newly allocated list of the objects contained\n"

2
libguile/vectors.h
View file

@ -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_p (SCM x);
extern SCM scm_vector_length (SCM v); extern SCM scm_vector_length (SCM v);
extern SCM scm_vector (SCM l); extern SCM scm_vector (SCM l);