mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-06-21 19:20:21 +02:00
* 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.
This commit is contained in:
Han-Wen Nienhuys
parent
8f28ea31bb
commit
1d1559ce6d
10 changed files with 158 additions and 143 deletions
|
|
@ -22,6 +22,7 @@ errnos.list
|
|||
fd.h
|
||||
gh_test_c
|
||||
gh_test_repl
|
||||
goops.c
|
||||
guile
|
||||
guile-doc-snarf
|
||||
guile-func-name-check
|
||||
|
|
|
|||
|
|
@ -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>
|
||||
|
||||
* *.c: add space after commas everywhere.
|
||||
|
|
|
|||
|
|
@ -594,6 +594,9 @@ obarray_retrieve (SCM obarray, SCM sym)
|
|||
PRECONDITION:
|
||||
|
||||
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
|
||||
SCM
|
||||
|
|
|
|||
|
|
@ -80,22 +80,12 @@ typedef scm_t_cell * SCM_CELLPTR;
|
|||
# define PTR2SCM(x) (SCM_PACK ((scm_t_bits) (x)))
|
||||
#endif /* def _UNICOS */
|
||||
|
||||
#ifdef GENGC
|
||||
/*
|
||||
TODO
|
||||
*/
|
||||
#else /* ! genGC */
|
||||
|
||||
#define SCM_GC_CARD_N_HEADER_CELLS 1
|
||||
#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_SET_CARD_BVEC(card, bvec) \
|
||||
((card)->word_0 = (scm_t_bits) (bvec))
|
||||
#endif
|
||||
|
||||
|
||||
#define SCM_GC_CARD_SIZE (SCM_GC_CARD_N_CELLS * sizeof (scm_t_cell))
|
||||
|
|
|
|||
|
|
@ -49,6 +49,7 @@
|
|||
#include "libguile/print.h"
|
||||
#include "libguile/root.h"
|
||||
#include "libguile/smob.h"
|
||||
#include "libguile/deprecation.h"
|
||||
|
||||
#include "libguile/validate.h"
|
||||
#include "libguile/macros.h"
|
||||
|
|
|
|||
|
|
@ -153,8 +153,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_c_make_vector (5, SCM_UNSPECIFIED);
|
||||
SCM *ve = SCM_WRITABLE_VELTS (ans);
|
||||
SCM result = scm_c_make_vector (5, SCM_UNSPECIFIED);
|
||||
SCM lst = SCM_EOL;
|
||||
struct hostent *entry;
|
||||
struct in_addr inad;
|
||||
|
|
@ -190,14 +189,14 @@ SCM_DEFINE (scm_gethost, "gethost", 0, 1, 0,
|
|||
if (!entry)
|
||||
scm_resolv_error (FUNC_NAME, host);
|
||||
|
||||
SCM_VECTOR_SET(ans, 0, scm_mem2string (entry->h_name, strlen (entry->h_name)));
|
||||
SCM_VECTOR_SET(ans, 1, scm_makfromstrs (-1, entry->h_aliases));
|
||||
SCM_VECTOR_SET(ans, 2, SCM_MAKINUM (entry->h_addrtype + 0L));
|
||||
SCM_VECTOR_SET(ans, 3, SCM_MAKINUM (entry->h_length + 0L));
|
||||
SCM_VECTOR_SET(result, 0, scm_mem2string (entry->h_name, strlen (entry->h_name)));
|
||||
SCM_VECTOR_SET(result, 1, scm_makfromstrs (-1, entry->h_aliases));
|
||||
SCM_VECTOR_SET(result, 2, SCM_MAKINUM (entry->h_addrtype + 0L));
|
||||
SCM_VECTOR_SET(result, 3, SCM_MAKINUM (entry->h_length + 0L));
|
||||
if (sizeof (struct in_addr) != entry->h_length)
|
||||
{
|
||||
SCM_VECTOR_SET(ans, 4, SCM_BOOL_F);
|
||||
return ans;
|
||||
SCM_VECTOR_SET(result, 4, SCM_BOOL_F);
|
||||
return result;
|
||||
}
|
||||
for (argv = entry->h_addr_list; argv[i]; i++);
|
||||
while (i--)
|
||||
|
|
@ -205,8 +204,8 @@ SCM_DEFINE (scm_gethost, "gethost", 0, 1, 0,
|
|||
inad = *(struct in_addr *) argv[i];
|
||||
lst = scm_cons (scm_ulong2num (ntohl (inad.s_addr)), lst);
|
||||
}
|
||||
SCM_VECTOR_SET(ans, 4, lst);
|
||||
return ans;
|
||||
SCM_VECTOR_SET(result, 4, lst);
|
||||
return result;
|
||||
}
|
||||
#undef FUNC_NAME
|
||||
|
||||
|
|
@ -232,13 +231,9 @@ SCM_DEFINE (scm_getnet, "getnet", 0, 1, 0,
|
|||
"given.")
|
||||
#define FUNC_NAME s_scm_getnet
|
||||
{
|
||||
SCM ans;
|
||||
SCM *ve;
|
||||
SCM result = scm_c_make_vector (4, SCM_UNSPECIFIED);
|
||||
struct netent *entry;
|
||||
|
||||
ans = scm_c_make_vector (4, SCM_UNSPECIFIED);
|
||||
ve = SCM_WRITABLE_VELTS (ans);
|
||||
|
||||
if (SCM_UNBNDP (net))
|
||||
{
|
||||
entry = getnetent ();
|
||||
|
|
@ -262,11 +257,11 @@ SCM_DEFINE (scm_getnet, "getnet", 0, 1, 0,
|
|||
}
|
||||
if (!entry)
|
||||
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(ans, 1, scm_makfromstrs (-1, entry->n_aliases));
|
||||
SCM_VECTOR_SET(ans, 2, SCM_MAKINUM (entry->n_addrtype + 0L));
|
||||
SCM_VECTOR_SET(ans, 3, scm_ulong2num (entry->n_net + 0L));
|
||||
return ans;
|
||||
SCM_VECTOR_SET(result, 0, scm_mem2string (entry->n_name, strlen (entry->n_name)));
|
||||
SCM_VECTOR_SET(result, 1, scm_makfromstrs (-1, entry->n_aliases));
|
||||
SCM_VECTOR_SET(result, 2, SCM_MAKINUM (entry->n_addrtype + 0L));
|
||||
SCM_VECTOR_SET(result, 3, scm_ulong2num (entry->n_net + 0L));
|
||||
return result;
|
||||
}
|
||||
#undef FUNC_NAME
|
||||
#endif
|
||||
|
|
@ -282,12 +277,9 @@ SCM_DEFINE (scm_getproto, "getproto", 0, 1, 0,
|
|||
"@code{getprotoent} (see below) if no arguments are supplied.")
|
||||
#define FUNC_NAME s_scm_getproto
|
||||
{
|
||||
SCM ans;
|
||||
SCM *ve;
|
||||
struct protoent *entry;
|
||||
SCM result = scm_c_make_vector (3, SCM_UNSPECIFIED);
|
||||
|
||||
ans = scm_c_make_vector (3, SCM_UNSPECIFIED);
|
||||
ve = SCM_WRITABLE_VELTS (ans);
|
||||
struct protoent *entry;
|
||||
if (SCM_UNBNDP (protocol))
|
||||
{
|
||||
entry = getprotoent ();
|
||||
|
|
@ -311,10 +303,10 @@ SCM_DEFINE (scm_getproto, "getproto", 0, 1, 0,
|
|||
}
|
||||
if (!entry)
|
||||
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(ans, 1, scm_makfromstrs (-1, entry->p_aliases));
|
||||
SCM_VECTOR_SET(ans, 2, SCM_MAKINUM (entry->p_proto + 0L));
|
||||
return ans;
|
||||
SCM_VECTOR_SET(result, 0, scm_mem2string (entry->p_name, strlen (entry->p_name)));
|
||||
SCM_VECTOR_SET(result, 1, scm_makfromstrs (-1, entry->p_aliases));
|
||||
SCM_VECTOR_SET(result, 2, SCM_MAKINUM (entry->p_proto + 0L));
|
||||
return result;
|
||||
}
|
||||
#undef FUNC_NAME
|
||||
#endif
|
||||
|
|
@ -323,16 +315,13 @@ SCM_DEFINE (scm_getproto, "getproto", 0, 1, 0,
|
|||
static SCM
|
||||
scm_return_entry (struct servent *entry)
|
||||
{
|
||||
SCM ans;
|
||||
SCM *ve;
|
||||
SCM result = scm_c_make_vector (4, SCM_UNSPECIFIED);
|
||||
|
||||
ans = scm_c_make_vector (4, SCM_UNSPECIFIED);
|
||||
ve = SCM_WRITABLE_VELTS (ans);
|
||||
SCM_VECTOR_SET(ans, 0, scm_mem2string (entry->s_name, strlen (entry->s_name)));
|
||||
SCM_VECTOR_SET(ans, 1, scm_makfromstrs (-1, entry->s_aliases));
|
||||
SCM_VECTOR_SET(ans, 2, SCM_MAKINUM (ntohs (entry->s_port) + 0L));
|
||||
SCM_VECTOR_SET(ans, 3, scm_mem2string (entry->s_proto, strlen (entry->s_proto)));
|
||||
return ans;
|
||||
SCM_VECTOR_SET(result, 0, scm_mem2string (entry->s_name, strlen (entry->s_name)));
|
||||
SCM_VECTOR_SET(result, 1, scm_makfromstrs (-1, entry->s_aliases));
|
||||
SCM_VECTOR_SET(result, 2, SCM_MAKINUM (ntohs (entry->s_port) + 0L));
|
||||
SCM_VECTOR_SET(result, 3, scm_mem2string (entry->s_proto, strlen (entry->s_proto)));
|
||||
return result;
|
||||
}
|
||||
|
||||
SCM_DEFINE (scm_getserv, "getserv", 0, 2, 0,
|
||||
|
|
|
|||
|
|
@ -222,7 +222,7 @@ SCM_DEFINE (scm_getgroups, "getgroups", 0, 0, 0,
|
|||
"supplementary group IDs.")
|
||||
#define FUNC_NAME s_scm_getgroups
|
||||
{
|
||||
SCM ans;
|
||||
SCM result;
|
||||
int ngroups;
|
||||
size_t size;
|
||||
GETGROUPS_T *groups;
|
||||
|
|
@ -235,16 +235,16 @@ SCM_DEFINE (scm_getgroups, "getgroups", 0, 0, 0,
|
|||
groups = scm_malloc (size);
|
||||
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)
|
||||
ve[ngroups] = SCM_MAKINUM (groups [ngroups]);
|
||||
}
|
||||
free (groups);
|
||||
return ans;
|
||||
return result;
|
||||
}
|
||||
#undef FUNC_NAME
|
||||
#endif
|
||||
|
|
@ -259,7 +259,7 @@ SCM_DEFINE (scm_getpwuid, "getpw", 0, 1, 0,
|
|||
{
|
||||
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))
|
||||
{
|
||||
SCM_SYSCALL (entry = getpwent ());
|
||||
|
|
@ -280,20 +280,20 @@ SCM_DEFINE (scm_getpwuid, "getpw", 0, 1, 0,
|
|||
if (!entry)
|
||||
SCM_MISC_ERROR ("entry not found", SCM_EOL);
|
||||
|
||||
SCM_VECTOR_SET(ans, 0, scm_makfrom0str (entry->pw_name));
|
||||
SCM_VECTOR_SET(ans, 1, scm_makfrom0str (entry->pw_passwd));
|
||||
SCM_VECTOR_SET(ans, 2, scm_ulong2num ((unsigned long) entry->pw_uid));
|
||||
SCM_VECTOR_SET(ans, 3, scm_ulong2num ((unsigned long) entry->pw_gid));
|
||||
SCM_VECTOR_SET(ans, 4, scm_makfrom0str (entry->pw_gecos));
|
||||
SCM_VECTOR_SET(result, 0, scm_makfrom0str (entry->pw_name));
|
||||
SCM_VECTOR_SET(result, 1, scm_makfrom0str (entry->pw_passwd));
|
||||
SCM_VECTOR_SET(result, 2, scm_ulong2num ((unsigned long) entry->pw_uid));
|
||||
SCM_VECTOR_SET(result, 3, scm_ulong2num ((unsigned long) entry->pw_gid));
|
||||
SCM_VECTOR_SET(result, 4, scm_makfrom0str (entry->pw_gecos));
|
||||
if (!entry->pw_dir)
|
||||
SCM_VECTOR_SET(ans, 5, scm_makfrom0str (""));
|
||||
SCM_VECTOR_SET(result, 5, scm_makfrom0str (""));
|
||||
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)
|
||||
SCM_VECTOR_SET(ans, 6, scm_makfrom0str (""));
|
||||
SCM_VECTOR_SET(result, 6, scm_makfrom0str (""));
|
||||
else
|
||||
SCM_VECTOR_SET(ans, 6, scm_makfrom0str (entry->pw_shell));
|
||||
return ans;
|
||||
SCM_VECTOR_SET(result, 6, scm_makfrom0str (entry->pw_shell));
|
||||
return result;
|
||||
}
|
||||
#undef FUNC_NAME
|
||||
#endif /* HAVE_GETPWENT */
|
||||
|
|
@ -327,7 +327,7 @@ SCM_DEFINE (scm_getgrgid, "getgr", 0, 1, 0,
|
|||
#define FUNC_NAME s_scm_getgrgid
|
||||
{
|
||||
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))
|
||||
{
|
||||
|
|
@ -347,11 +347,11 @@ SCM_DEFINE (scm_getgrgid, "getgr", 0, 1, 0,
|
|||
if (!entry)
|
||||
SCM_SYSERROR;
|
||||
|
||||
SCM_VECTOR_SET(ans, 0, scm_makfrom0str (entry->gr_name));
|
||||
SCM_VECTOR_SET(ans, 1, scm_makfrom0str (entry->gr_passwd));
|
||||
SCM_VECTOR_SET(ans, 2, scm_ulong2num ((unsigned long) entry->gr_gid));
|
||||
SCM_VECTOR_SET(ans, 3, scm_makfromstrs (-1, entry->gr_mem));
|
||||
return ans;
|
||||
SCM_VECTOR_SET(result, 0, scm_makfrom0str (entry->gr_name));
|
||||
SCM_VECTOR_SET(result, 1, scm_makfrom0str (entry->gr_passwd));
|
||||
SCM_VECTOR_SET(result, 2, scm_ulong2num ((unsigned long) entry->gr_gid));
|
||||
SCM_VECTOR_SET(result, 3, scm_makfromstrs (-1, entry->gr_mem));
|
||||
return result;
|
||||
}
|
||||
#undef FUNC_NAME
|
||||
|
||||
|
|
@ -741,7 +741,7 @@ SCM_DEFINE (scm_ttyname, "ttyname", 1, 0, 0,
|
|||
"underlying @var{port}.")
|
||||
#define FUNC_NAME s_scm_ttyname
|
||||
{
|
||||
char *ans;
|
||||
char *result;
|
||||
int fd;
|
||||
|
||||
port = SCM_COERCE_OUTPORT (port);
|
||||
|
|
@ -749,11 +749,11 @@ SCM_DEFINE (scm_ttyname, "ttyname", 1, 0, 0,
|
|||
if (!SCM_FPORTP (port))
|
||||
return SCM_BOOL_F;
|
||||
fd = SCM_FPORT_FDES (port);
|
||||
SCM_SYSCALL (ans = ttyname (fd));
|
||||
if (!ans)
|
||||
SCM_SYSCALL (result = ttyname (fd));
|
||||
if (!result)
|
||||
SCM_SYSERROR;
|
||||
/* ans could be overwritten by another call to ttyname */
|
||||
return (scm_makfrom0str (ans));
|
||||
/* result could be overwritten by another call to ttyname */
|
||||
return (scm_makfrom0str (result));
|
||||
}
|
||||
#undef FUNC_NAME
|
||||
#endif /* HAVE_TTYNAME */
|
||||
|
|
@ -982,19 +982,19 @@ SCM_DEFINE (scm_uname, "uname", 0, 0, 0,
|
|||
#define FUNC_NAME s_scm_uname
|
||||
{
|
||||
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)
|
||||
SCM_SYSERROR;
|
||||
SCM_VECTOR_SET(ans, 0, scm_makfrom0str (buf.sysname));
|
||||
SCM_VECTOR_SET(ans, 1, scm_makfrom0str (buf.nodename));
|
||||
SCM_VECTOR_SET(ans, 2, scm_makfrom0str (buf.release));
|
||||
SCM_VECTOR_SET(ans, 3, scm_makfrom0str (buf.version));
|
||||
SCM_VECTOR_SET(ans, 4, scm_makfrom0str (buf.machine));
|
||||
SCM_VECTOR_SET(result, 0, scm_makfrom0str (buf.sysname));
|
||||
SCM_VECTOR_SET(result, 1, scm_makfrom0str (buf.nodename));
|
||||
SCM_VECTOR_SET(result, 2, scm_makfrom0str (buf.release));
|
||||
SCM_VECTOR_SET(result, 3, scm_makfrom0str (buf.version));
|
||||
SCM_VECTOR_SET(result, 4, scm_makfrom0str (buf.machine));
|
||||
/*
|
||||
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
|
||||
#endif /* HAVE_UNAME */
|
||||
|
|
|
|||
|
|
@ -925,7 +925,7 @@ static SCM
|
|||
scm_addr_vector (const struct sockaddr *address, const char *proc)
|
||||
{
|
||||
short int fam = address->sa_family;
|
||||
SCM ans =SCM_EOL;
|
||||
SCM result =SCM_EOL;
|
||||
|
||||
|
||||
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;
|
||||
|
||||
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(ans, 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, 0, scm_ulong2num ((unsigned long) fam));
|
||||
SCM_VECTOR_SET(result, 1, scm_ulong2num (ntohl (nad->sin_addr.s_addr)));
|
||||
SCM_VECTOR_SET(result, 2, scm_ulong2num ((unsigned long) ntohs (nad->sin_port)));
|
||||
}
|
||||
break;
|
||||
#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;
|
||||
|
||||
ans = scm_c_make_vector (5, SCM_UNSPECIFIED);
|
||||
SCM_VECTOR_SET(ans, 0, scm_ulong2num ((unsigned long) fam));
|
||||
SCM_VECTOR_SET(ans, 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(ans, 3, scm_ulong2num ((unsigned long) nad->sin6_flowinfo));
|
||||
result = scm_c_make_vector (5, SCM_UNSPECIFIED);
|
||||
SCM_VECTOR_SET(result, 0, scm_ulong2num ((unsigned long) fam));
|
||||
SCM_VECTOR_SET(result, 1, ipv6_net_to_num (nad->sin6_addr.s6_addr));
|
||||
SCM_VECTOR_SET(result, 2, scm_ulong2num ((unsigned long) ntohs (nad->sin6_port)));
|
||||
SCM_VECTOR_SET(result, 3, scm_ulong2num ((unsigned long) nad->sin6_flowinfo));
|
||||
#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
|
||||
SCM_VECTOR_SET(ans, 4, SCM_INUM0);
|
||||
SCM_VECTOR_SET(result, 4, SCM_INUM0);
|
||||
#endif
|
||||
}
|
||||
break;
|
||||
|
|
@ -964,10 +964,10 @@ scm_addr_vector (const struct sockaddr *address, const char *proc)
|
|||
{
|
||||
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(ans, 1, scm_mem2string (nad->sun_path, strlen (nad->sun_path)));
|
||||
SCM_VECTOR_SET(result, 0, scm_ulong2num ((unsigned long) fam));
|
||||
SCM_VECTOR_SET(result, 1, scm_mem2string (nad->sun_path, strlen (nad->sun_path)));
|
||||
}
|
||||
break;
|
||||
#endif
|
||||
|
|
@ -975,7 +975,7 @@ scm_addr_vector (const struct sockaddr *address, const char *proc)
|
|||
scm_misc_error (proc, "Unrecognised address family: ~A",
|
||||
scm_list_1 (SCM_MAKINUM (fam)));
|
||||
}
|
||||
return ans;
|
||||
return result;
|
||||
}
|
||||
|
||||
/* calculate the size of a buffer large enough to hold any supported
|
||||
|
|
|
|||
|
|
@ -437,7 +437,6 @@ SCM_DEFINE (scm_restricted_vector_sort_x, "restricted-vector-sort!", 4, 0, 0,
|
|||
len = SCM_INUM (endpos) - spos;
|
||||
|
||||
quicksort (&vp[spos], len, size, scm_cmp_function (less), less);
|
||||
SCM_GC_FLAG_OBJECT_WRITE(vec);
|
||||
|
||||
return SCM_UNSPECIFIED;
|
||||
/* return vec; */
|
||||
|
|
@ -784,43 +783,55 @@ SCM_DEFINE (scm_sort, "sort", 2, 0, 0,
|
|||
#undef FUNC_NAME
|
||||
|
||||
static void
|
||||
scm_merge_vector_x (void *const vecbase,
|
||||
void *const tempbase,
|
||||
scm_merge_vector_x (SCM vec,
|
||||
SCM * temp,
|
||||
cmp_fun_t cmp,
|
||||
SCM less,
|
||||
long low,
|
||||
long mid,
|
||||
long high)
|
||||
{
|
||||
register SCM *vp = (SCM *) vecbase;
|
||||
register SCM *temp = (SCM *) tempbase;
|
||||
long it; /* Index for temp vector */
|
||||
long i1 = low; /* Index for lower vector segment */
|
||||
long i2 = mid + 1; /* Index for upper vector segment */
|
||||
|
||||
/* Copy while both segments contain more characters */
|
||||
for (it = low; (i1 <= mid) && (i2 <= high); ++it)
|
||||
if ((*cmp) (less, &vp[i2], &vp[i1]))
|
||||
temp[it] = vp[i2++];
|
||||
else
|
||||
temp[it] = vp[i1++];
|
||||
{
|
||||
/*
|
||||
Every call of LESS might invoke GC. For full correctness, we
|
||||
should reset the generation of vecbase and tempbase between
|
||||
every call of less.
|
||||
|
||||
/* Copy while first segment contains more characters */
|
||||
while (i1 <= mid)
|
||||
temp[it++] = vp[i1++];
|
||||
*/
|
||||
register SCM *vp = SCM_WRITABLE_VELTS(vec);
|
||||
|
||||
if ((*cmp) (less, &vp[i2], &vp[i1]))
|
||||
temp[it] = vp[i2++];
|
||||
else
|
||||
temp[it] = vp[i1++];
|
||||
}
|
||||
|
||||
/* Copy while second segment contains more characters */
|
||||
while (i2 <= high)
|
||||
temp[it++] = vp[i2++];
|
||||
{
|
||||
register SCM *vp = SCM_WRITABLE_VELTS(vec);
|
||||
|
||||
/* Copy while first segment contains more characters */
|
||||
while (i1 <= mid)
|
||||
temp[it++] = vp[i1++];
|
||||
|
||||
/* Copy back from temp to vp */
|
||||
for (it = low; it <= high; ++it)
|
||||
vp[it] = temp[it];
|
||||
} /* scm_merge_vector_x */
|
||||
/* Copy while second segment contains more characters */
|
||||
while (i2 <= high)
|
||||
temp[it++] = vp[i2++];
|
||||
|
||||
/* Copy back from temp to vp */
|
||||
for (it = low; it <= high; ++it)
|
||||
vp[it] = temp[it];
|
||||
}
|
||||
} /* scm_merge_vector_x */
|
||||
|
||||
static void
|
||||
scm_merge_vector_step (void *const vp,
|
||||
void *const temp,
|
||||
scm_merge_vector_step (SCM vp,
|
||||
SCM * temp,
|
||||
cmp_fun_t cmp,
|
||||
SCM less,
|
||||
long low,
|
||||
|
|
@ -860,18 +871,16 @@ SCM_DEFINE (scm_stable_sort_x, "stable-sort!", 2, 0, 0,
|
|||
}
|
||||
else if (SCM_VECTORP (items))
|
||||
{
|
||||
SCM *temp, *vp;
|
||||
SCM *temp;
|
||||
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));
|
||||
|
||||
|
||||
vp = SCM_WRITABLE_VELTS (items);
|
||||
/*
|
||||
This routine modifies VP
|
||||
*/
|
||||
|
||||
SCM_GC_FLAG_OBJECT_WRITE(items);
|
||||
scm_merge_vector_step (vp,
|
||||
scm_merge_vector_step (items,
|
||||
temp,
|
||||
scm_cmp_function (less),
|
||||
less,
|
||||
|
|
@ -886,7 +895,6 @@ SCM_DEFINE (scm_stable_sort_x, "stable-sort!", 2, 0, 0,
|
|||
#undef FUNC_NAME
|
||||
|
||||
/* stable_sort manages lists and vectors */
|
||||
|
||||
SCM_DEFINE (scm_stable_sort, "stable-sort", 2, 0, 0,
|
||||
(SCM items, SCM less),
|
||||
"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.")
|
||||
#define FUNC_NAME s_scm_stable_sort
|
||||
{
|
||||
long len; /* list/vector length */
|
||||
|
||||
if (SCM_NULL_OR_NIL_P (items))
|
||||
return items;
|
||||
|
||||
SCM_VALIDATE_NIM (2, less);
|
||||
if (SCM_CONSP (items))
|
||||
{
|
||||
long len; /* list/vector length */
|
||||
SCM_VALIDATE_LIST_COPYLEN (1, items, len);
|
||||
items = scm_list_copy (items);
|
||||
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? */
|
||||
else if (SCM_VECTORP (items))
|
||||
{
|
||||
SCM retvec;
|
||||
SCM *temp, *vp;
|
||||
len = SCM_VECTOR_LENGTH (items);
|
||||
retvec = scm_make_uve (len, scm_array_prototype (items));
|
||||
long len = SCM_VECTOR_LENGTH (items);
|
||||
SCM *temp = malloc (len * sizeof (SCM));
|
||||
SCM retvec = scm_make_uve (len, scm_array_prototype (items));
|
||||
scm_array_copy_x (items, retvec);
|
||||
temp = malloc (len * sizeof (SCM));
|
||||
|
||||
/*
|
||||
don't worry about write barrier: retvec is new anyway.
|
||||
*/
|
||||
vp = SCM_WRITABLE_VELTS (retvec);
|
||||
|
||||
scm_merge_vector_step (vp,
|
||||
scm_merge_vector_step (retvec,
|
||||
temp,
|
||||
scm_cmp_function (less),
|
||||
less,
|
||||
|
|
|
|||
|
|
@ -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));
|
||||
|
||||
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;
|
||||
}
|
||||
|
|
@ -333,7 +337,12 @@ SCM_DEFINE (scm_vector_move_right_x, "vector-move-right!", 5, 0, 0,
|
|||
j = e - i + j;
|
||||
SCM_ASSERT_RANGE (5, start2, j <= SCM_VECTOR_LENGTH (vec2));
|
||||
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;
|
||||
}
|
||||
#undef FUNC_NAME
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue