mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-22 03:30:22 +02:00
Code Activity

* macros.c: include deprecation.h

Browse source 
* vectors.c (s_scm_vector_move_right_x): remove side effect in
macro arg.
(s_scm_vector_move_left_x): idem.

* net_db.c, posix.c, socket.c: variable naming: change ans to
result.

* sort.c (scm_merge_vector_x): accept vector as argument
iso. SCM*. This is needed for full GC correctness.

* gc.h: undo previous undocumented changes related to #ifdef
GENGC.
This commit is contained in:
Han-Wen Nienhuys 2002-07-21 17:46:23 +00:00
parent 8f28ea31bb
commit 1d1559ce6d
10 changed files with 158 additions and 143 deletions
Download patch file Download diff file Expand all files Collapse all files

1
libguile/.cvsignore
View file

@ -22,6 +22,7 @@ errnos.list
fd.h fd.h
gh_test_c gh_test_c
gh_test_repl gh_test_repl
goops.c
guile guile
guile-doc-snarf guile-doc-snarf
guile-func-name-check guile-func-name-check

20
libguile/ChangeLog
View file

@ -1,3 +1,23 @@
2002-07-21 Han-Wen <hanwen@cs.uu.nl>
* goops.c (scm_compute_applicable_methods): use
scm_remember_upto_here_1 iso scm_remember_upto_here
* macros.c: include deprecation.h
* vectors.c (s_scm_vector_move_right_x): remove side effect in
macro arg.
(s_scm_vector_move_left_x): idem.
* net_db.c, posix.c, socket.c: variable naming: change ans to
result.
* sort.c (scm_merge_vector_x): accept vector as argument
iso. SCM*. This is needed for full GC correctness.
* gc.h: undo previous undocumented changes related to #ifdef
GENGC.
2002-07-20 Han-Wen <hanwen@cs.uu.nl> 2002-07-20 Han-Wen <hanwen@cs.uu.nl>
* *.c: add space after commas everywhere. * *.c: add space after commas everywhere.

3
libguile/environments.c
View file

@ -594,6 +594,9 @@ obarray_retrieve (SCM obarray, SCM sym)
PRECONDITION: PRECONDITION:
length (ALIST) >= 1 length (ALIST) >= 1
This could also be done by combining scm_delq1_x () and
scm_sloppy_assq(), at the cost of walking the list another time.
*/ */
static static
SCM SCM

10
libguile/gc.h
View file

@ -80,22 +80,12 @@ typedef scm_t_cell * SCM_CELLPTR;
# define PTR2SCM(x) (SCM_PACK ((scm_t_bits) (x))) # define PTR2SCM(x) (SCM_PACK ((scm_t_bits) (x)))
#endif /* def _UNICOS */ #endif /* def _UNICOS */
#ifdef GENGC
/*
TODO
*/
#else /* ! genGC */
#define SCM_GC_CARD_N_HEADER_CELLS 1 #define SCM_GC_CARD_N_HEADER_CELLS 1
#define SCM_GC_CARD_N_CELLS 256 #define SCM_GC_CARD_N_CELLS 256
#define SCM_GC_CARD_GENERATION(card)
#define SCM_GC_FLAG_OBJECT_WRITE(x)
#define SCM_GC_CARD_BVEC(card) ((scm_t_c_bvec_limb *) ((card)->word_0)) #define SCM_GC_CARD_BVEC(card) ((scm_t_c_bvec_limb *) ((card)->word_0))
#define SCM_GC_SET_CARD_BVEC(card, bvec) \ #define SCM_GC_SET_CARD_BVEC(card, bvec) \
((card)->word_0 = (scm_t_bits) (bvec)) ((card)->word_0 = (scm_t_bits) (bvec))
#endif
#define SCM_GC_CARD_SIZE (SCM_GC_CARD_N_CELLS * sizeof (scm_t_cell)) #define SCM_GC_CARD_SIZE (SCM_GC_CARD_N_CELLS * sizeof (scm_t_cell))

1
libguile/macros.c
View file

@ -49,6 +49,7 @@
#include "libguile/print.h" #include "libguile/print.h"
#include "libguile/root.h" #include "libguile/root.h"
#include "libguile/smob.h" #include "libguile/smob.h"
#include "libguile/deprecation.h"
#include "libguile/validate.h" #include "libguile/validate.h"
#include "libguile/macros.h" #include "libguile/macros.h"

65
libguile/net_db.c
View file

@ -153,8 +153,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_c_make_vector (5, SCM_UNSPECIFIED); SCM result = scm_c_make_vector (5, SCM_UNSPECIFIED);
SCM *ve = SCM_WRITABLE_VELTS (ans);
SCM lst = SCM_EOL; SCM lst = SCM_EOL;
struct hostent *entry; struct hostent *entry;
struct in_addr inad; struct in_addr inad;
@ -190,14 +189,14 @@ SCM_DEFINE (scm_gethost, "gethost", 0, 1, 0,
if (!entry) if (!entry)
scm_resolv_error (FUNC_NAME, host); scm_resolv_error (FUNC_NAME, host);
SCM_VECTOR_SET(ans, 0, scm_mem2string (entry->h_name, strlen (entry->h_name))); SCM_VECTOR_SET(result, 0, scm_mem2string (entry->h_name, strlen (entry->h_name)));
SCM_VECTOR_SET(ans, 1, scm_makfromstrs (-1, entry->h_aliases)); SCM_VECTOR_SET(result, 1, scm_makfromstrs (-1, entry->h_aliases));
SCM_VECTOR_SET(ans, 2, SCM_MAKINUM (entry->h_addrtype + 0L)); SCM_VECTOR_SET(result, 2, SCM_MAKINUM (entry->h_addrtype + 0L));
SCM_VECTOR_SET(ans, 3, SCM_MAKINUM (entry->h_length + 0L)); SCM_VECTOR_SET(result, 3, SCM_MAKINUM (entry->h_length + 0L));
if (sizeof (struct in_addr) != entry->h_length) if (sizeof (struct in_addr) != entry->h_length)
{ {
SCM_VECTOR_SET(ans, 4, SCM_BOOL_F); SCM_VECTOR_SET(result, 4, SCM_BOOL_F);
return ans; return result;
} }
for (argv = entry->h_addr_list; argv[i]; i++); for (argv = entry->h_addr_list; argv[i]; i++);
while (i--) while (i--)
@ -205,8 +204,8 @@ SCM_DEFINE (scm_gethost, "gethost", 0, 1, 0,
inad = *(struct in_addr *) argv[i]; inad = *(struct in_addr *) argv[i];
lst = scm_cons (scm_ulong2num (ntohl (inad.s_addr)), lst); lst = scm_cons (scm_ulong2num (ntohl (inad.s_addr)), lst);
} }
SCM_VECTOR_SET(ans, 4, lst); SCM_VECTOR_SET(result, 4, lst);
return ans; return result;
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -232,13 +231,9 @@ SCM_DEFINE (scm_getnet, "getnet", 0, 1, 0,
"given.") "given.")
#define FUNC_NAME s_scm_getnet #define FUNC_NAME s_scm_getnet
{ {
SCM ans; SCM result = scm_c_make_vector (4, SCM_UNSPECIFIED);
SCM *ve;
struct netent *entry; struct netent *entry;
ans = scm_c_make_vector (4, SCM_UNSPECIFIED);
ve = SCM_WRITABLE_VELTS (ans);
if (SCM_UNBNDP (net)) if (SCM_UNBNDP (net))
{ {
entry = getnetent (); entry = getnetent ();
@ -262,11 +257,11 @@ SCM_DEFINE (scm_getnet, "getnet", 0, 1, 0,
} }
if (!entry) if (!entry)
SCM_SYSERROR_MSG ("no such network ~A", scm_list_1 (net), errno); SCM_SYSERROR_MSG ("no such network ~A", scm_list_1 (net), errno);
SCM_VECTOR_SET(ans, 0, scm_mem2string (entry->n_name, strlen (entry->n_name))); SCM_VECTOR_SET(result, 0, scm_mem2string (entry->n_name, strlen (entry->n_name)));
SCM_VECTOR_SET(ans, 1, scm_makfromstrs (-1, entry->n_aliases)); SCM_VECTOR_SET(result, 1, scm_makfromstrs (-1, entry->n_aliases));
SCM_VECTOR_SET(ans, 2, SCM_MAKINUM (entry->n_addrtype + 0L)); SCM_VECTOR_SET(result, 2, SCM_MAKINUM (entry->n_addrtype + 0L));
SCM_VECTOR_SET(ans, 3, scm_ulong2num (entry->n_net + 0L)); SCM_VECTOR_SET(result, 3, scm_ulong2num (entry->n_net + 0L));
return ans; return result;
} }
#undef FUNC_NAME #undef FUNC_NAME
#endif #endif
@ -282,12 +277,9 @@ SCM_DEFINE (scm_getproto, "getproto", 0, 1, 0,
"@code{getprotoent} (see below) if no arguments are supplied.") "@code{getprotoent} (see below) if no arguments are supplied.")
#define FUNC_NAME s_scm_getproto #define FUNC_NAME s_scm_getproto
{ {
SCM ans; SCM result = scm_c_make_vector (3, SCM_UNSPECIFIED);
SCM *ve;
struct protoent *entry;
ans = scm_c_make_vector (3, SCM_UNSPECIFIED); struct protoent *entry;
ve = SCM_WRITABLE_VELTS (ans);
if (SCM_UNBNDP (protocol)) if (SCM_UNBNDP (protocol))
{ {
entry = getprotoent (); entry = getprotoent ();
@ -311,10 +303,10 @@ SCM_DEFINE (scm_getproto, "getproto", 0, 1, 0,
} }
if (!entry) if (!entry)
SCM_SYSERROR_MSG ("no such protocol ~A", scm_list_1 (protocol), errno); SCM_SYSERROR_MSG ("no such protocol ~A", scm_list_1 (protocol), errno);
SCM_VECTOR_SET(ans, 0, scm_mem2string (entry->p_name, strlen (entry->p_name))); SCM_VECTOR_SET(result, 0, scm_mem2string (entry->p_name, strlen (entry->p_name)));
SCM_VECTOR_SET(ans, 1, scm_makfromstrs (-1, entry->p_aliases)); SCM_VECTOR_SET(result, 1, scm_makfromstrs (-1, entry->p_aliases));
SCM_VECTOR_SET(ans, 2, SCM_MAKINUM (entry->p_proto + 0L)); SCM_VECTOR_SET(result, 2, SCM_MAKINUM (entry->p_proto + 0L));
return ans; return result;
} }
#undef FUNC_NAME #undef FUNC_NAME
#endif #endif
@ -323,16 +315,13 @@ SCM_DEFINE (scm_getproto, "getproto", 0, 1, 0,
static SCM static SCM
scm_return_entry (struct servent *entry) scm_return_entry (struct servent *entry)
{ {
SCM ans; SCM result = scm_c_make_vector (4, SCM_UNSPECIFIED);
SCM *ve;
ans = scm_c_make_vector (4, SCM_UNSPECIFIED); SCM_VECTOR_SET(result, 0, scm_mem2string (entry->s_name, strlen (entry->s_name)));
ve = SCM_WRITABLE_VELTS (ans); SCM_VECTOR_SET(result, 1, scm_makfromstrs (-1, entry->s_aliases));
SCM_VECTOR_SET(ans, 0, scm_mem2string (entry->s_name, strlen (entry->s_name))); SCM_VECTOR_SET(result, 2, SCM_MAKINUM (ntohs (entry->s_port) + 0L));
SCM_VECTOR_SET(ans, 1, scm_makfromstrs (-1, entry->s_aliases)); SCM_VECTOR_SET(result, 3, scm_mem2string (entry->s_proto, strlen (entry->s_proto)));
SCM_VECTOR_SET(ans, 2, SCM_MAKINUM (ntohs (entry->s_port) + 0L)); return result;
SCM_VECTOR_SET(ans, 3, scm_mem2string (entry->s_proto, strlen (entry->s_proto)));
return ans;
} }
SCM_DEFINE (scm_getserv, "getserv", 0, 2, 0, SCM_DEFINE (scm_getserv, "getserv", 0, 2, 0,

68
libguile/posix.c
View file

@ -222,7 +222,7 @@ SCM_DEFINE (scm_getgroups, "getgroups", 0, 0, 0,
"supplementary group IDs.") "supplementary group IDs.")
#define FUNC_NAME s_scm_getgroups #define FUNC_NAME s_scm_getgroups
{ {
SCM ans; SCM result;
int ngroups; int ngroups;
size_t size; size_t size;
GETGROUPS_T *groups; GETGROUPS_T *groups;
@ -235,16 +235,16 @@ SCM_DEFINE (scm_getgroups, "getgroups", 0, 0, 0,
groups = scm_malloc (size); groups = scm_malloc (size);
getgroups (ngroups, groups); getgroups (ngroups, groups);
ans = scm_c_make_vector (ngroups, SCM_UNDEFINED); result = scm_c_make_vector (ngroups, SCM_UNDEFINED);
{ {
SCM * ve = SCM_WRITABLE_VELTS(ans); SCM * ve = SCM_WRITABLE_VELTS(result);
while (--ngroups >= 0) while (--ngroups >= 0)
ve[ngroups] = SCM_MAKINUM (groups [ngroups]); ve[ngroups] = SCM_MAKINUM (groups [ngroups]);
} }
free (groups); free (groups);
return ans; return result;
} }
#undef FUNC_NAME #undef FUNC_NAME
#endif #endif
@ -259,7 +259,7 @@ SCM_DEFINE (scm_getpwuid, "getpw", 0, 1, 0,
{ {
struct passwd *entry; struct passwd *entry;
SCM ans = scm_c_make_vector (7, SCM_UNSPECIFIED); SCM result = scm_c_make_vector (7, SCM_UNSPECIFIED);
if (SCM_UNBNDP (user) || SCM_FALSEP (user)) if (SCM_UNBNDP (user) || SCM_FALSEP (user))
{ {
SCM_SYSCALL (entry = getpwent ()); SCM_SYSCALL (entry = getpwent ());
@ -280,20 +280,20 @@ SCM_DEFINE (scm_getpwuid, "getpw", 0, 1, 0,
if (!entry) if (!entry)
SCM_MISC_ERROR ("entry not found", SCM_EOL); SCM_MISC_ERROR ("entry not found", SCM_EOL);
SCM_VECTOR_SET(ans, 0, scm_makfrom0str (entry->pw_name)); SCM_VECTOR_SET(result, 0, scm_makfrom0str (entry->pw_name));
SCM_VECTOR_SET(ans, 1, scm_makfrom0str (entry->pw_passwd)); SCM_VECTOR_SET(result, 1, scm_makfrom0str (entry->pw_passwd));
SCM_VECTOR_SET(ans, 2, scm_ulong2num ((unsigned long) entry->pw_uid)); SCM_VECTOR_SET(result, 2, scm_ulong2num ((unsigned long) entry->pw_uid));
SCM_VECTOR_SET(ans, 3, scm_ulong2num ((unsigned long) entry->pw_gid)); SCM_VECTOR_SET(result, 3, scm_ulong2num ((unsigned long) entry->pw_gid));
SCM_VECTOR_SET(ans, 4, scm_makfrom0str (entry->pw_gecos)); SCM_VECTOR_SET(result, 4, scm_makfrom0str (entry->pw_gecos));
if (!entry->pw_dir) if (!entry->pw_dir)
SCM_VECTOR_SET(ans, 5, scm_makfrom0str ("")); SCM_VECTOR_SET(result, 5, scm_makfrom0str (""));
else else
SCM_VECTOR_SET(ans, 5, scm_makfrom0str (entry->pw_dir)); SCM_VECTOR_SET(result, 5, scm_makfrom0str (entry->pw_dir));
if (!entry->pw_shell) if (!entry->pw_shell)
SCM_VECTOR_SET(ans, 6, scm_makfrom0str ("")); SCM_VECTOR_SET(result, 6, scm_makfrom0str (""));
else else
SCM_VECTOR_SET(ans, 6, scm_makfrom0str (entry->pw_shell)); SCM_VECTOR_SET(result, 6, scm_makfrom0str (entry->pw_shell));
return ans; return result;
} }
#undef FUNC_NAME #undef FUNC_NAME
#endif /* HAVE_GETPWENT */ #endif /* HAVE_GETPWENT */
@ -327,7 +327,7 @@ SCM_DEFINE (scm_getgrgid, "getgr", 0, 1, 0,
#define FUNC_NAME s_scm_getgrgid #define FUNC_NAME s_scm_getgrgid
{ {
struct group *entry; struct group *entry;
SCM ans = scm_c_make_vector (4, SCM_UNSPECIFIED); SCM result = scm_c_make_vector (4, SCM_UNSPECIFIED);
if (SCM_UNBNDP (name) || SCM_FALSEP (name)) if (SCM_UNBNDP (name) || SCM_FALSEP (name))
{ {
@ -347,11 +347,11 @@ SCM_DEFINE (scm_getgrgid, "getgr", 0, 1, 0,
if (!entry) if (!entry)
SCM_SYSERROR; SCM_SYSERROR;
SCM_VECTOR_SET(ans, 0, scm_makfrom0str (entry->gr_name)); SCM_VECTOR_SET(result, 0, scm_makfrom0str (entry->gr_name));
SCM_VECTOR_SET(ans, 1, scm_makfrom0str (entry->gr_passwd)); SCM_VECTOR_SET(result, 1, scm_makfrom0str (entry->gr_passwd));
SCM_VECTOR_SET(ans, 2, scm_ulong2num ((unsigned long) entry->gr_gid)); SCM_VECTOR_SET(result, 2, scm_ulong2num ((unsigned long) entry->gr_gid));
SCM_VECTOR_SET(ans, 3, scm_makfromstrs (-1, entry->gr_mem)); SCM_VECTOR_SET(result, 3, scm_makfromstrs (-1, entry->gr_mem));
return ans; return result;
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -741,7 +741,7 @@ SCM_DEFINE (scm_ttyname, "ttyname", 1, 0, 0,
"underlying @var{port}.") "underlying @var{port}.")
#define FUNC_NAME s_scm_ttyname #define FUNC_NAME s_scm_ttyname
{ {
char *ans; char *result;
int fd; int fd;
port = SCM_COERCE_OUTPORT (port); port = SCM_COERCE_OUTPORT (port);
@ -749,11 +749,11 @@ SCM_DEFINE (scm_ttyname, "ttyname", 1, 0, 0,
if (!SCM_FPORTP (port)) if (!SCM_FPORTP (port))
return SCM_BOOL_F; return SCM_BOOL_F;
fd = SCM_FPORT_FDES (port); fd = SCM_FPORT_FDES (port);
SCM_SYSCALL (ans = ttyname (fd)); SCM_SYSCALL (result = ttyname (fd));
if (!ans) if (!result)
SCM_SYSERROR; SCM_SYSERROR;
/* ans could be overwritten by another call to ttyname */ /* result could be overwritten by another call to ttyname */
return (scm_makfrom0str (ans)); return (scm_makfrom0str (result));
} }
#undef FUNC_NAME #undef FUNC_NAME
#endif /* HAVE_TTYNAME */ #endif /* HAVE_TTYNAME */
@ -982,19 +982,19 @@ 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_c_make_vector (5, SCM_UNSPECIFIED); SCM result = scm_c_make_vector (5, SCM_UNSPECIFIED);
if (uname (&buf) < 0) if (uname (&buf) < 0)
SCM_SYSERROR; SCM_SYSERROR;
SCM_VECTOR_SET(ans, 0, scm_makfrom0str (buf.sysname)); SCM_VECTOR_SET(result, 0, scm_makfrom0str (buf.sysname));
SCM_VECTOR_SET(ans, 1, scm_makfrom0str (buf.nodename)); SCM_VECTOR_SET(result, 1, scm_makfrom0str (buf.nodename));
SCM_VECTOR_SET(ans, 2, scm_makfrom0str (buf.release)); SCM_VECTOR_SET(result, 2, scm_makfrom0str (buf.release));
SCM_VECTOR_SET(ans, 3, scm_makfrom0str (buf.version)); SCM_VECTOR_SET(result, 3, scm_makfrom0str (buf.version));
SCM_VECTOR_SET(ans, 4, scm_makfrom0str (buf.machine)); SCM_VECTOR_SET(result, 4, scm_makfrom0str (buf.machine));
/* /*
a linux special? a linux special?
SCM_VECTOR_SET(ans, 5, scm_makfrom0str (buf.domainname)); SCM_VECTOR_SET(result, 5, scm_makfrom0str (buf.domainname));
*/ */
return ans; return result;
} }
#undef FUNC_NAME #undef FUNC_NAME
#endif /* HAVE_UNAME */ #endif /* HAVE_UNAME */

32
libguile/socket.c
View file

@ -925,7 +925,7 @@ static SCM
scm_addr_vector (const struct sockaddr *address, const char *proc) scm_addr_vector (const struct sockaddr *address, const char *proc)
{ {
short int fam = address->sa_family; short int fam = address->sa_family;
SCM ans =SCM_EOL; SCM result =SCM_EOL;
switch (fam) switch (fam)
@ -934,11 +934,11 @@ scm_addr_vector (const struct sockaddr *address, const char *proc)
{ {
const struct sockaddr_in *nad = (struct sockaddr_in *) address; const struct sockaddr_in *nad = (struct sockaddr_in *) address;
ans = scm_c_make_vector (3, SCM_UNSPECIFIED); result = scm_c_make_vector (3, SCM_UNSPECIFIED);
SCM_VECTOR_SET(ans, 0, scm_ulong2num ((unsigned long) fam)); SCM_VECTOR_SET(result, 0, scm_ulong2num ((unsigned long) fam));
SCM_VECTOR_SET(ans, 1, scm_ulong2num (ntohl (nad->sin_addr.s_addr))); SCM_VECTOR_SET(result, 1, scm_ulong2num (ntohl (nad->sin_addr.s_addr)));
SCM_VECTOR_SET(ans, 2, scm_ulong2num ((unsigned long) ntohs (nad->sin_port))); SCM_VECTOR_SET(result, 2, scm_ulong2num ((unsigned long) ntohs (nad->sin_port)));
} }
break; break;
#ifdef HAVE_IPV6 #ifdef HAVE_IPV6
@ -946,15 +946,15 @@ scm_addr_vector (const struct sockaddr *address, const char *proc)
{ {
const struct sockaddr_in6 *nad = (struct sockaddr_in6 *) address; const struct sockaddr_in6 *nad = (struct sockaddr_in6 *) address;
ans = scm_c_make_vector (5, SCM_UNSPECIFIED); result = scm_c_make_vector (5, SCM_UNSPECIFIED);
SCM_VECTOR_SET(ans, 0, scm_ulong2num ((unsigned long) fam)); SCM_VECTOR_SET(result, 0, scm_ulong2num ((unsigned long) fam));
SCM_VECTOR_SET(ans, 1, ipv6_net_to_num (nad->sin6_addr.s6_addr)); SCM_VECTOR_SET(result, 1, ipv6_net_to_num (nad->sin6_addr.s6_addr));
SCM_VECTOR_SET(ans, 2, scm_ulong2num ((unsigned long) ntohs (nad->sin6_port))); SCM_VECTOR_SET(result, 2, scm_ulong2num ((unsigned long) ntohs (nad->sin6_port)));
SCM_VECTOR_SET(ans, 3, scm_ulong2num ((unsigned long) nad->sin6_flowinfo)); SCM_VECTOR_SET(result, 3, scm_ulong2num ((unsigned long) nad->sin6_flowinfo));
#ifdef HAVE_SIN6_SCOPE_ID #ifdef HAVE_SIN6_SCOPE_ID
SCM_VECTOR_SET(ans, 4, scm_ulong2num ((unsigned long) nad->sin6_scope_id)); SCM_VECTOR_SET(result, 4, scm_ulong2num ((unsigned long) nad->sin6_scope_id));
#else #else
SCM_VECTOR_SET(ans, 4, SCM_INUM0); SCM_VECTOR_SET(result, 4, SCM_INUM0);
#endif #endif
} }
break; break;
@ -964,10 +964,10 @@ scm_addr_vector (const struct sockaddr *address, const char *proc)
{ {
const struct sockaddr_un *nad = (struct sockaddr_un *) address; const struct sockaddr_un *nad = (struct sockaddr_un *) address;
ans = scm_c_make_vector (2, SCM_UNSPECIFIED); result = scm_c_make_vector (2, SCM_UNSPECIFIED);
SCM_VECTOR_SET(ans, 0, scm_ulong2num ((unsigned long) fam)); SCM_VECTOR_SET(result, 0, scm_ulong2num ((unsigned long) fam));
SCM_VECTOR_SET(ans, 1, scm_mem2string (nad->sun_path, strlen (nad->sun_path))); SCM_VECTOR_SET(result, 1, scm_mem2string (nad->sun_path, strlen (nad->sun_path)));
} }
break; break;
#endif #endif
@ -975,7 +975,7 @@ scm_addr_vector (const struct sockaddr *address, const char *proc)
scm_misc_error (proc, "Unrecognised address family: ~A", scm_misc_error (proc, "Unrecognised address family: ~A",
scm_list_1 (SCM_MAKINUM (fam))); scm_list_1 (SCM_MAKINUM (fam)));
} }
return ans; return result;
} }
/* calculate the size of a buffer large enough to hold any supported /* calculate the size of a buffer large enough to hold any supported

60
libguile/sort.c
View file

@ -437,7 +437,6 @@ SCM_DEFINE (scm_restricted_vector_sort_x, "restricted-vector-sort!", 4, 0, 0,
len = SCM_INUM (endpos) - spos; len = SCM_INUM (endpos) - spos;
quicksort (&vp[spos], len, size, scm_cmp_function (less), less); quicksort (&vp[spos], len, size, scm_cmp_function (less), less);
SCM_GC_FLAG_OBJECT_WRITE(vec);
return SCM_UNSPECIFIED; return SCM_UNSPECIFIED;
/* return vec; */ /* return vec; */
@ -784,26 +783,37 @@ SCM_DEFINE (scm_sort, "sort", 2, 0, 0,
#undef FUNC_NAME #undef FUNC_NAME
static void static void
scm_merge_vector_x (void *const vecbase, scm_merge_vector_x (SCM vec,
void *const tempbase, SCM * temp,
cmp_fun_t cmp, cmp_fun_t cmp,
SCM less, SCM less,
long low, long low,
long mid, long mid,
long high) long high)
{ {
register SCM *vp = (SCM *) vecbase;
register SCM *temp = (SCM *) tempbase;
long it; /* Index for temp vector */ long it; /* Index for temp vector */
long i1 = low; /* Index for lower vector segment */ long i1 = low; /* Index for lower vector segment */
long i2 = mid + 1; /* Index for upper vector segment */ long i2 = mid + 1; /* Index for upper vector segment */
/* Copy while both segments contain more characters */ /* Copy while both segments contain more characters */
for (it = low; (i1 <= mid) && (i2 <= high); ++it) for (it = low; (i1 <= mid) && (i2 <= high); ++it)
{
/*
Every call of LESS might invoke GC. For full correctness, we
should reset the generation of vecbase and tempbase between
every call of less.
*/
register SCM *vp = SCM_WRITABLE_VELTS(vec);
if ((*cmp) (less, &vp[i2], &vp[i1])) if ((*cmp) (less, &vp[i2], &vp[i1]))
temp[it] = vp[i2++]; temp[it] = vp[i2++];
else else
temp[it] = vp[i1++]; temp[it] = vp[i1++];
}
{
register SCM *vp = SCM_WRITABLE_VELTS(vec);
/* Copy while first segment contains more characters */ /* Copy while first segment contains more characters */
while (i1 <= mid) while (i1 <= mid)
@ -816,11 +826,12 @@ scm_merge_vector_x (void *const vecbase,
/* Copy back from temp to vp */ /* Copy back from temp to vp */
for (it = low; it <= high; ++it) for (it = low; it <= high; ++it)
vp[it] = temp[it]; vp[it] = temp[it];
}
} /* scm_merge_vector_x */ } /* scm_merge_vector_x */
static void static void
scm_merge_vector_step (void *const vp, scm_merge_vector_step (SCM vp,
void *const temp, SCM * temp,
cmp_fun_t cmp, cmp_fun_t cmp,
SCM less, SCM less,
long low, long low,
@ -860,18 +871,16 @@ SCM_DEFINE (scm_stable_sort_x, "stable-sort!", 2, 0, 0,
} }
else if (SCM_VECTORP (items)) else if (SCM_VECTORP (items))
{ {
SCM *temp, *vp; SCM *temp;
len = SCM_VECTOR_LENGTH (items); len = SCM_VECTOR_LENGTH (items);
/*
the following array does not contain any new references to
SCM objects, so we can get away with allocing it on the heap.
*/
temp = malloc (len * sizeof(SCM)); temp = malloc (len * sizeof(SCM));
scm_merge_vector_step (items,
vp = SCM_WRITABLE_VELTS (items);
/*
This routine modifies VP
*/
SCM_GC_FLAG_OBJECT_WRITE(items);
scm_merge_vector_step (vp,
temp, temp,
scm_cmp_function (less), scm_cmp_function (less),
less, less,
@ -886,7 +895,6 @@ SCM_DEFINE (scm_stable_sort_x, "stable-sort!", 2, 0, 0,
#undef FUNC_NAME #undef FUNC_NAME
/* stable_sort manages lists and vectors */ /* stable_sort manages lists and vectors */
SCM_DEFINE (scm_stable_sort, "stable-sort", 2, 0, 0, SCM_DEFINE (scm_stable_sort, "stable-sort", 2, 0, 0,
(SCM items, SCM less), (SCM items, SCM less),
"Sort the sequence @var{items}, which may be a list or a\n" "Sort the sequence @var{items}, which may be a list or a\n"
@ -894,13 +902,14 @@ SCM_DEFINE (scm_stable_sort, "stable-sort", 2, 0, 0,
"This is a stable sort.") "This is a stable sort.")
#define FUNC_NAME s_scm_stable_sort #define FUNC_NAME s_scm_stable_sort
{ {
long len; /* list/vector length */
if (SCM_NULL_OR_NIL_P (items)) if (SCM_NULL_OR_NIL_P (items))
return items; return items;
SCM_VALIDATE_NIM (2, less); SCM_VALIDATE_NIM (2, less);
if (SCM_CONSP (items)) if (SCM_CONSP (items))
{ {
long len; /* list/vector length */
SCM_VALIDATE_LIST_COPYLEN (1, items, len); SCM_VALIDATE_LIST_COPYLEN (1, items, len);
items = scm_list_copy (items); items = scm_list_copy (items);
return scm_merge_list_step (&items, scm_cmp_function (less), less, len); return scm_merge_list_step (&items, scm_cmp_function (less), less, len);
@ -909,19 +918,12 @@ SCM_DEFINE (scm_stable_sort, "stable-sort", 2, 0, 0,
/* support ordinary vectors even if arrays not available? */ /* support ordinary vectors even if arrays not available? */
else if (SCM_VECTORP (items)) else if (SCM_VECTORP (items))
{ {
SCM retvec; long len = SCM_VECTOR_LENGTH (items);
SCM *temp, *vp; SCM *temp = malloc (len * sizeof (SCM));
len = SCM_VECTOR_LENGTH (items); SCM retvec = scm_make_uve (len, scm_array_prototype (items));
retvec = scm_make_uve (len, scm_array_prototype (items));
scm_array_copy_x (items, retvec); scm_array_copy_x (items, retvec);
temp = malloc (len * sizeof (SCM));
/* scm_merge_vector_step (retvec,
don't worry about write barrier: retvec is new anyway.
*/
vp = SCM_WRITABLE_VELTS (retvec);
scm_merge_vector_step (vp,
temp, temp,
scm_cmp_function (less), scm_cmp_function (less),
less, less,

13
libguile/vectors.c
View file

@ -301,7 +301,11 @@ SCM_DEFINE (scm_vector_move_left_x, "vector-move-left!", 5, 0, 0,
SCM_ASSERT_RANGE (5, start2, e-i+j <= SCM_VECTOR_LENGTH (vec2)); SCM_ASSERT_RANGE (5, start2, e-i+j <= SCM_VECTOR_LENGTH (vec2));
while (i<e) while (i<e)
SCM_VECTOR_SET (vec2, j++, SCM_VELTS (vec1)[i++]); {
SCM_VECTOR_SET (vec2, j, SCM_VELTS (vec1)[i]);
i++;
j++;
}
return SCM_UNSPECIFIED; return SCM_UNSPECIFIED;
} }
@ -333,7 +337,12 @@ SCM_DEFINE (scm_vector_move_right_x, "vector-move-right!", 5, 0, 0,
j = e - i + j; j = e - i + j;
SCM_ASSERT_RANGE (5, start2, j <= SCM_VECTOR_LENGTH (vec2)); SCM_ASSERT_RANGE (5, start2, j <= SCM_VECTOR_LENGTH (vec2));
while (i < e) while (i < e)
SCM_VECTOR_SET (vec2, --j, SCM_VELTS (vec1)[--e]); {
j--;
e--;
SCM_VECTOR_SET (vec2, j, SCM_VELTS (vec1)[e]);
}
return SCM_UNSPECIFIED; return SCM_UNSPECIFIED;
} }
#undef FUNC_NAME #undef FUNC_NAME