From 1d1559ce6dc6190cb46d00c479a12ec51af12011 Mon Sep 17 00:00:00 2001 From: Han-Wen Nienhuys Date: Sun, 21 Jul 2002 17:46:23 +0000 Subject: [PATCH] * 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. --- libguile/.cvsignore | 1 + libguile/ChangeLog | 20 ++++++++++ libguile/environments.c | 3 ++ libguile/gc.h | 10 ----- libguile/macros.c | 1 + libguile/net_db.c | 67 +++++++++++++------------------ libguile/posix.c | 68 +++++++++++++++---------------- libguile/socket.c | 32 +++++++-------- libguile/sort.c | 88 +++++++++++++++++++++-------------------- libguile/vectors.c | 13 +++++- 10 files changed, 159 insertions(+), 144 deletions(-) diff --git a/libguile/.cvsignore b/libguile/.cvsignore index d5d8f2a5e..9df5f259b 100644 --- a/libguile/.cvsignore +++ b/libguile/.cvsignore @@ -22,6 +22,7 @@ errnos.list fd.h gh_test_c gh_test_repl +goops.c guile guile-doc-snarf guile-func-name-check diff --git a/libguile/ChangeLog b/libguile/ChangeLog index 3f95b31ed..5aa4ce9ab 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,23 @@ +2002-07-21 Han-Wen + + * 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 * *.c: add space after commas everywhere. diff --git a/libguile/environments.c b/libguile/environments.c index a5cc3c244..26cf424e2 100644 --- a/libguile/environments.c +++ b/libguile/environments.c @@ -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 diff --git a/libguile/gc.h b/libguile/gc.h index 72ac83074..0296ea0e0 100644 --- a/libguile/gc.h +++ b/libguile/gc.h @@ -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)) diff --git a/libguile/macros.c b/libguile/macros.c index 77c068519..55fae13d6 100644 --- a/libguile/macros.c +++ b/libguile/macros.c @@ -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" diff --git a/libguile/net_db.c b/libguile/net_db.c index 12885642e..f5a6537dc 100644 --- a/libguile/net_db.c +++ b/libguile/net_db.c @@ -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; - - 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 result = scm_c_make_vector (4, SCM_UNSPECIFIED); + + 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, diff --git a/libguile/posix.c b/libguile/posix.c index f9d8a22e0..a4da1a8cf 100644 --- a/libguile/posix.c +++ b/libguile/posix.c @@ -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 */ diff --git a/libguile/socket.c b/libguile/socket.c index 5ea34d78a..bf1dc019e 100644 --- a/libguile/socket.c +++ b/libguile/socket.c @@ -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 diff --git a/libguile/sort.c b/libguile/sort.c index 8bca27c41..e8b332e42 100644 --- a/libguile/sort.c +++ b/libguile/sort.c @@ -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++]; - - /* Copy while first segment contains more characters */ - while (i1 <= mid) - 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 second segment contains more characters */ - while (i2 <= high) - temp[it++] = vp[i2++]; + */ + register SCM *vp = SCM_WRITABLE_VELTS(vec); + + if ((*cmp) (less, &vp[i2], &vp[i1])) + temp[it] = vp[i2++]; + else + temp[it] = vp[i1++]; + } - /* Copy back from temp to vp */ - for (it = low; it <= high; ++it) - vp[it] = temp[it]; -} /* scm_merge_vector_x */ + { + register SCM *vp = SCM_WRITABLE_VELTS(vec); + + /* Copy while first segment contains more characters */ + while (i1 <= mid) + temp[it++] = vp[i1++]; + + /* 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); - temp = malloc (len * sizeof(SCM)); - - vp = SCM_WRITABLE_VELTS (items); /* - This routine modifies VP - */ + 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)); - 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, diff --git a/libguile/vectors.c b/libguile/vectors.c index 86dc0b121..947c333be 100644 --- a/libguile/vectors.c +++ b/libguile/vectors.c @@ -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