From f9caea823350640fb03195c73c301f08ce932bd0 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Sat, 30 Aug 2014 15:59:39 -0700 Subject: [PATCH] Vector-sorting fixes. It's not safe to call qsort or qsort_r, since they have undefined behavior if the user-specified predicate is not a total order. Also, watch out for garbage-collection while sorting vectors. * admin/merge-gnulib (GNULIB_MODULES): Add vla. * configure.ac (qsort_r): Remove, as we no longer use qsort-like functions. * lib/gnulib.mk, m4/gnulib-comp.m4: Regenerate. * lib/vla.h, m4/vararrays.m4: New files, copied from gnulib. * lib/stdlib.in.h, m4/stdlib_h.m4: Sync from gnulib, incorporating: 2014-08-29 qsort_r: new module, for GNU-style qsort_r The previous two files' changes are boilerplate generated by admin/merge-gnulib, and should not affect Emacs. * src/fns.c: Include . (sort_vector_predicate) [!HAVE_QSORT_R]: Remove. (sort_vector_compare): Remove, replacing with .... (inorder, merge_vectors, sort_vector_inplace, sort_vector_copy): ... these new functions. (sort_vector): Rewrite to use the new functions. GCPRO locals, since the predicate can invoke the GC. Since it's in-place return void; caller changed. (merge): Use 'inorder', for clarity. Fixes: debbugs:18361 --- ChangeLog | 12 ++++ admin/ChangeLog | 5 ++ admin/merge-gnulib | 2 +- configure.ac | 2 +- lib/gnulib.mk | 11 ++- lib/stdlib.in.h | 23 ++++++ lib/vla.h | 27 +++++++ m4/gnulib-comp.m4 | 5 ++ m4/stdlib_h.m4 | 2 + m4/vararrays.m4 | 68 ++++++++++++++++++ src/ChangeLog | 14 ++++ src/fns.c | 173 ++++++++++++++++++++++++++------------------- 12 files changed, 267 insertions(+), 77 deletions(-) create mode 100644 lib/vla.h create mode 100644 m4/vararrays.m4 diff --git a/ChangeLog b/ChangeLog index a998e4d2054..7f0127755aa 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,15 @@ +2014-08-30 Paul Eggert + + Vector-sorting fixes (Bug#18361). + * configure.ac (qsort_r): Remove, as we no longer use qsort-like + functions. + * lib/gnulib.mk, m4/gnulib-comp.m4: Regenerate. + * lib/vla.h, m4/vararrays.m4: New files, copied from gnulib. + * lib/stdlib.in.h, m4/stdlib_h.m4: Sync from gnulib, incorporating: + 2014-08-29 qsort_r: new module, for GNU-style qsort_r + The previous two files' changes are boilerplate generated by + admin/merge-gnulib, and should not affect Emacs. + 2014-08-29 Dmitry Antipov * configure.ac (AC_CHECK_FUNCS): Check for qsort_r. diff --git a/admin/ChangeLog b/admin/ChangeLog index f4bfa73911c..bbb673beddf 100644 --- a/admin/ChangeLog +++ b/admin/ChangeLog @@ -1,3 +1,8 @@ +2014-08-30 Paul Eggert + + Vector-sorting fixes (Bug#18361). + * merge-gnulib (GNULIB_MODULES): Add vla. + 2014-08-30 Eli Zaretskii * authors.el (authors): Fix last change so it works for MS-Windows diff --git a/admin/merge-gnulib b/admin/merge-gnulib index a11b6e06d27..5b9b716bed2 100755 --- a/admin/merge-gnulib +++ b/admin/merge-gnulib @@ -39,7 +39,7 @@ GNULIB_MODULES=' strftime strtoimax strtoumax symlink sys_stat sys_time time timer-time timespec-add timespec-sub unsetenv update-copyright utimens - warnings + vla warnings ' GNULIB_TOOL_FLAGS=' diff --git a/configure.ac b/configure.ac index ef3aad21732..4f17a55895e 100644 --- a/configure.ac +++ b/configure.ac @@ -3573,7 +3573,7 @@ select getpagesize setlocale newlocale \ getrlimit setrlimit shutdown getaddrinfo \ pthread_sigmask strsignal setitimer \ sendto recvfrom getsockname getpeername getifaddrs freeifaddrs \ -gai_strerror sync qsort_r \ +gai_strerror sync \ getpwent endpwent getgrent endgrent \ cfmakeraw cfsetspeed copysign __executable_start log2) LIBS=$OLD_LIBS diff --git a/lib/gnulib.mk b/lib/gnulib.mk index 9e9b9ebd6de..5ba7de10d0b 100644 --- a/lib/gnulib.mk +++ b/lib/gnulib.mk @@ -21,7 +21,7 @@ # the same distribution terms as the rest of that program. # # Generated by gnulib-tool. -# Reproduce by: gnulib-tool --import --dir=. --lib=libgnu --source-base=lib --m4-base=m4 --doc-base=doc --tests-base=tests --aux-dir=build-aux --avoid=close --avoid=dup --avoid=fchdir --avoid=fstat --avoid=malloc-posix --avoid=msvc-inval --avoid=msvc-nothrow --avoid=open --avoid=openat-die --avoid=opendir --avoid=raise --avoid=save-cwd --avoid=select --avoid=sigprocmask --avoid=stdarg --avoid=stdbool --avoid=threadlib --makefile-name=gnulib.mk --conditional-dependencies --no-libtool --macro-prefix=gl --no-vc-files alloca-opt binary-io byteswap c-ctype c-strcase careadlinkat close-stream count-one-bits count-trailing-zeros crypto/md5 crypto/sha1 crypto/sha256 crypto/sha512 dtoastr dtotimespec dup2 environ execinfo faccessat fcntl fcntl-h fdatasync fdopendir filemode fstatat fsync getloadavg getopt-gnu gettime gettimeofday intprops largefile lstat manywarnings memrchr mkostemp mktime pipe2 pselect pthread_sigmask putenv qacl readlink readlinkat sig2str socklen stat-time stdalign stdio strftime strtoimax strtoumax symlink sys_stat sys_time time timer-time timespec-add timespec-sub unsetenv update-copyright utimens warnings +# Reproduce by: gnulib-tool --import --dir=. --lib=libgnu --source-base=lib --m4-base=m4 --doc-base=doc --tests-base=tests --aux-dir=build-aux --avoid=close --avoid=dup --avoid=fchdir --avoid=fstat --avoid=malloc-posix --avoid=msvc-inval --avoid=msvc-nothrow --avoid=open --avoid=openat-die --avoid=opendir --avoid=raise --avoid=save-cwd --avoid=select --avoid=sigprocmask --avoid=stdarg --avoid=stdbool --avoid=threadlib --makefile-name=gnulib.mk --conditional-dependencies --no-libtool --macro-prefix=gl --no-vc-files alloca-opt binary-io byteswap c-ctype c-strcase careadlinkat close-stream count-one-bits count-trailing-zeros crypto/md5 crypto/sha1 crypto/sha256 crypto/sha512 dtoastr dtotimespec dup2 environ execinfo faccessat fcntl fcntl-h fdatasync fdopendir filemode fstatat fsync getloadavg getopt-gnu gettime gettimeofday intprops largefile lstat manywarnings memrchr mkostemp mktime pipe2 pselect pthread_sigmask putenv qacl readlink readlinkat sig2str socklen stat-time stdalign stdio strftime strtoimax strtoumax symlink sys_stat sys_time time timer-time timespec-add timespec-sub unsetenv update-copyright utimens vla warnings MOSTLYCLEANFILES += core *.stackdump @@ -1141,6 +1141,7 @@ stdlib.h: stdlib.in.h $(top_builddir)/config.status $(CXXDEFS_H) \ -e 's/@''GNULIB_PTSNAME''@/$(GNULIB_PTSNAME)/g' \ -e 's/@''GNULIB_PTSNAME_R''@/$(GNULIB_PTSNAME_R)/g' \ -e 's/@''GNULIB_PUTENV''@/$(GNULIB_PUTENV)/g' \ + -e 's/@''GNULIB_QSORT_R''@/$(GNULIB_QSORT_R)/g' \ -e 's/@''GNULIB_RANDOM''@/$(GNULIB_RANDOM)/g' \ -e 's/@''GNULIB_RANDOM_R''@/$(GNULIB_RANDOM_R)/g' \ -e 's/@''GNULIB_REALLOC_POSIX''@/$(GNULIB_REALLOC_POSIX)/g' \ @@ -1192,6 +1193,7 @@ stdlib.h: stdlib.in.h $(top_builddir)/config.status $(CXXDEFS_H) \ -e 's|@''REPLACE_PTSNAME''@|$(REPLACE_PTSNAME)|g' \ -e 's|@''REPLACE_PTSNAME_R''@|$(REPLACE_PTSNAME_R)|g' \ -e 's|@''REPLACE_PUTENV''@|$(REPLACE_PUTENV)|g' \ + -e 's|@''REPLACE_QSORT_R''@|$(REPLACE_QSORT_R)|g' \ -e 's|@''REPLACE_RANDOM_R''@|$(REPLACE_RANDOM_R)|g' \ -e 's|@''REPLACE_REALLOC''@|$(REPLACE_REALLOC)|g' \ -e 's|@''REPLACE_REALPATH''@|$(REPLACE_REALPATH)|g' \ @@ -1798,6 +1800,13 @@ EXTRA_DIST += verify.h ## end gnulib module verify +## begin gnulib module vla + + +EXTRA_DIST += vla.h + +## end gnulib module vla + ## begin gnulib module xalloc-oversized if gl_GNULIB_ENABLED_682e609604ccaac6be382e4ee3a4eaec diff --git a/lib/stdlib.in.h b/lib/stdlib.in.h index 46e10dba972..ee643247d85 100644 --- a/lib/stdlib.in.h +++ b/lib/stdlib.in.h @@ -520,6 +520,29 @@ _GL_CXXALIAS_SYS (putenv, int, (char *string)); _GL_CXXALIASWARN (putenv); #endif +#if @GNULIB_QSORT_R@ +# if @REPLACE_QSORT_R@ +# if !(defined __cplusplus && defined GNULIB_NAMESPACE) +# undef qsort_r +# define qsort_r rpl_qsort_r +# endif +_GL_FUNCDECL_RPL (qsort_r, void, (void *base, size_t nmemb, size_t size, + int (*compare) (void const *, void const *, + void *), + void *arg) _GL_ARG_NONNULL ((1, 4))); +_GL_CXXALIAS_RPL (qsort_r, void, (void *base, size_t nmemb, size_t size, + int (*compare) (void const *, void const *, + void *), + void *arg)); +# else +_GL_CXXALIAS_SYS (qsort_r, void, (void *base, size_t nmemb, size_t size, + int (*compare) (void const *, void const *, + void *), + void *arg)); +# endif +_GL_CXXALIASWARN (qsort_r); +#endif + #if @GNULIB_RANDOM_R@ # if !@HAVE_RANDOM_R@ diff --git a/lib/vla.h b/lib/vla.h new file mode 100644 index 00000000000..05125a7978e --- /dev/null +++ b/lib/vla.h @@ -0,0 +1,27 @@ +/* vla.h - variable length arrays + + Copyright 2014 Free Software Foundation, Inc. + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . + + Written by Paul Eggert. */ + +/* A function's argument must point to an array with at least N elements. + Example: 'int main (int argc, char *argv[VLA_ELEMS (argc)]);'. */ + +#ifdef __STDC_NO_VLA__ +# define VLA_ELEMS(n) +#else +# define VLA_ELEMS(n) static n +#endif diff --git a/m4/gnulib-comp.m4 b/m4/gnulib-comp.m4 index 98acc069c92..7b6b5c00f9d 100644 --- a/m4/gnulib-comp.m4 +++ b/m4/gnulib-comp.m4 @@ -146,7 +146,9 @@ AC_DEFUN([gl_EARLY], # Code from module unsetenv: # Code from module update-copyright: # Code from module utimens: + # Code from module vararrays: # Code from module verify: + # Code from module vla: # Code from module warnings: # Code from module xalloc-oversized: ]) @@ -383,6 +385,7 @@ AC_DEFUN([gl_INIT], fi gl_STDLIB_MODULE_INDICATOR([unsetenv]) gl_UTIMENS + AC_C_VARARRAYS gl_gnulib_enabled_260941c0e5dc67ec9e87d1fb321c300b=false gl_gnulib_enabled_dosname=false gl_gnulib_enabled_euidaccess=false @@ -916,6 +919,7 @@ AC_DEFUN([gl_FILE_LIST], [ lib/utimens.c lib/utimens.h lib/verify.h + lib/vla.h lib/xalloc-oversized.h m4/00gnulib.m4 m4/absolute-header.m4 @@ -1013,6 +1017,7 @@ AC_DEFUN([gl_FILE_LIST], [ m4/utimbuf.m4 m4/utimens.m4 m4/utimes.m4 + m4/vararrays.m4 m4/warn-on-use.m4 m4/warnings.m4 m4/wchar_t.m4 diff --git a/m4/stdlib_h.m4 b/m4/stdlib_h.m4 index 03b448b94f4..86aff16eb05 100644 --- a/m4/stdlib_h.m4 +++ b/m4/stdlib_h.m4 @@ -55,6 +55,7 @@ AC_DEFUN([gl_STDLIB_H_DEFAULTS], GNULIB_PTSNAME=0; AC_SUBST([GNULIB_PTSNAME]) GNULIB_PTSNAME_R=0; AC_SUBST([GNULIB_PTSNAME_R]) GNULIB_PUTENV=0; AC_SUBST([GNULIB_PUTENV]) + GNULIB_QSORT_R=0; AC_SUBST([GNULIB_QSORT_R]) GNULIB_RANDOM=0; AC_SUBST([GNULIB_RANDOM]) GNULIB_RANDOM_R=0; AC_SUBST([GNULIB_RANDOM_R]) GNULIB_REALLOC_POSIX=0; AC_SUBST([GNULIB_REALLOC_POSIX]) @@ -107,6 +108,7 @@ AC_DEFUN([gl_STDLIB_H_DEFAULTS], REPLACE_PTSNAME=0; AC_SUBST([REPLACE_PTSNAME]) REPLACE_PTSNAME_R=0; AC_SUBST([REPLACE_PTSNAME_R]) REPLACE_PUTENV=0; AC_SUBST([REPLACE_PUTENV]) + REPLACE_QSORT_R=0; AC_SUBST([REPLACE_QSORT_R]) REPLACE_RANDOM_R=0; AC_SUBST([REPLACE_RANDOM_R]) REPLACE_REALLOC=0; AC_SUBST([REPLACE_REALLOC]) REPLACE_REALPATH=0; AC_SUBST([REPLACE_REALPATH]) diff --git a/m4/vararrays.m4 b/m4/vararrays.m4 new file mode 100644 index 00000000000..cbda525c75e --- /dev/null +++ b/m4/vararrays.m4 @@ -0,0 +1,68 @@ +# Check for variable-length arrays. + +# serial 5 + +# From Paul Eggert + +# Copyright (C) 2001, 2009-2014 Free Software Foundation, Inc. +# This file is free software; the Free Software Foundation +# gives unlimited permission to copy and/or distribute it, +# with or without modifications, as long as this notice is preserved. + +# This is a copy of AC_C_VARARRAYS from a recent development version +# of Autoconf. It replaces Autoconf's version, or for pre-2.61 autoconf +# it defines the macro that Autoconf lacks. +AC_DEFUN([AC_C_VARARRAYS], +[ + AC_CACHE_CHECK([for variable-length arrays], + ac_cv_c_vararrays, + [AC_EGREP_CPP([defined], + [#ifdef __STDC_NO_VLA__ + defined + #endif + ], + [ac_cv_c_vararrays='no: __STDC_NO_VLA__ is defined'], + [AC_COMPILE_IFELSE( + [AC_LANG_PROGRAM( + [[/* Test for VLA support. This test is partly inspired + from examples in the C standard. Use at least two VLA + functions to detect the GCC 3.4.3 bug described in: + http://lists.gnu.org/archive/html/bug-gnulib/2014-08/msg00014.html + */ + #ifdef __STDC_NO_VLA__ + syntax error; + #else + extern int n; + int B[100]; + int fvla (int m, int C[m][m]); + + int + simple (int count, int all[static count]) + { + return all[count - 1]; + } + + int + fvla (int m, int C[m][m]) + { + typedef int VLA[m][m]; + VLA x; + int D[m]; + static int (*q)[m] = &B; + int (*s)[n] = q; + return C && &x[0][0] == &D[0] && &D[0] == s[0]; + } + #endif + ]])], + [ac_cv_c_vararrays=yes], + [ac_cv_c_vararrays=no])])]) + if test "$ac_cv_c_vararrays" = yes; then + dnl This is for compatibility with Autoconf 2.61-2.69. + AC_DEFINE([HAVE_C_VARARRAYS], 1, + [Define to 1 if C supports variable-length arrays.]) + elif test "$ac_cv_c_vararrays" = no; then + AC_DEFINE([__STDC_NO_VLA__], 1, + [Define to 1 if C does not support variable-length arrays, and + if the compiler does not already define this.]) + fi +]) diff --git a/src/ChangeLog b/src/ChangeLog index b348932f0a9..00ec5dcf3d6 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,5 +1,19 @@ 2014-08-30 Paul Eggert + Vector-sorting fixes (Bug#18361). + It's not safe to call qsort or qsort_r, since they have undefined + behavior if the user-specified predicate is not a total order. + Also, watch out for garbage-collection while sorting vectors. + * fns.c: Include . + (sort_vector_predicate) [!HAVE_QSORT_R]: Remove. + (sort_vector_compare): Remove, replacing with .... + (inorder, merge_vectors, sort_vector_inplace, sort_vector_copy): + ... these new functions. + (sort_vector): Rewrite to use the new functions. + GCPRO locals, since the predicate can invoke the GC. + Since it's in-place return void; caller changed. + (merge): Use 'inorder', for clarity. + * sysdep.c (str_collate): Clear errno just before wcscoll(_l). One can't hoist this out of the 'if', because intervening calls to newlocale, twolower, etc. can change errno. diff --git a/src/fns.c b/src/fns.c index f838599230b..57c57884f4d 100644 --- a/src/fns.c +++ b/src/fns.c @@ -24,6 +24,7 @@ along with GNU Emacs. If not, see . */ #include #include +#include #include "lisp.h" #include "commands.h" @@ -49,6 +50,8 @@ static Lisp_Object Qcodeset, Qdays, Qmonths, Qpaper; static Lisp_Object Qmd5, Qsha1, Qsha224, Qsha256, Qsha384, Qsha512; +static void sort_vector_copy (Lisp_Object, ptrdiff_t, + Lisp_Object [restrict], Lisp_Object [restrict]); static bool internal_equal (Lisp_Object, Lisp_Object, int, bool, Lisp_Object); DEFUN ("identity", Fidentity, Sidentity, 1, 1, 0, @@ -1897,86 +1900,109 @@ sort_list (Lisp_Object list, Lisp_Object predicate) return merge (front, back, predicate); } -/* Using GNU qsort_r, we can pass this as a parameter. This also - exists on FreeBSD and Darwin/OSX, but with a different signature. */ -#ifndef HAVE_QSORT_R -static Lisp_Object sort_vector_predicate; -#endif +/* Using PRED to compare, return whether A and B are in order. + Compare stably when A appeared before B in the input. */ +static bool +inorder (Lisp_Object pred, Lisp_Object a, Lisp_Object b) +{ + return NILP (call2 (pred, b, a)); +} -/* Comparison function called by qsort. */ - -static int -#ifdef HAVE_QSORT_R -#if defined (DARWIN_OS) || defined (__FreeBSD__) -sort_vector_compare (void *arg, const void *p, const void *q) -#elif defined (GNU_LINUX) -sort_vector_compare (const void *p, const void *q, void *arg) -#else /* neither darwin/bsd nor gnu/linux */ -#error "check how qsort_r comparison function works on your platform" -#endif /* DARWIN_OS || __FreeBSD__ */ -#else /* not HAVE_QSORT_R */ -sort_vector_compare (const void *p, const void *q) -#endif /* HAVE_QSORT_R */ -{ - bool more, less; - Lisp_Object op, oq, vp, vq; -#ifdef HAVE_QSORT_R - Lisp_Object sort_vector_predicate = *(Lisp_Object *) arg; -#endif +/* Using PRED to compare, merge from ALEN-length A and BLEN-length B + into DEST. Argument arrays must be nonempty and must not overlap, + except that B might be the last part of DEST. */ +static void +merge_vectors (Lisp_Object pred, + ptrdiff_t alen, Lisp_Object const a[restrict VLA_ELEMS (alen)], + ptrdiff_t blen, Lisp_Object const b[VLA_ELEMS (blen)], + Lisp_Object dest[VLA_ELEMS (alen + blen)]) +{ + eassume (0 < alen && 0 < blen); + Lisp_Object const *alim = a + alen; + Lisp_Object const *blim = b + blen; - op = *(Lisp_Object *) p; - oq = *(Lisp_Object *) q; - vp = XSAVE_OBJECT (op, 1); - vq = XSAVE_OBJECT (oq, 1); + while (true) + { + if (inorder (pred, a[0], b[0])) + { + *dest++ = *a++; + if (a == alim) + { + if (dest != b) + memcpy (dest, b, (blim - b) * sizeof *dest); + return; + } + } + else + { + *dest++ = *b++; + if (b == blim) + { + memcpy (dest, a, (alim - a) * sizeof *dest); + return; + } + } + } +} - /* Use recorded element index as a secondary key to - preserve original order. Pretty ugly but works. */ - more = NILP (call2 (sort_vector_predicate, vp, vq)); - less = NILP (call2 (sort_vector_predicate, vq, vp)); - return ((more && !less) ? 1 - : ((!more && less) ? -1 - : XSAVE_INTEGER (op, 0) - XSAVE_INTEGER (oq, 0))); +/* Using PRED to compare, sort LEN-length VEC in place, using TMP for + temporary storage. LEN must be at least 2. */ +static void +sort_vector_inplace (Lisp_Object pred, ptrdiff_t len, + Lisp_Object vec[restrict VLA_ELEMS (len)], + Lisp_Object tmp[restrict VLA_ELEMS (len >> 1)]) +{ + eassume (2 <= len); + ptrdiff_t halflen = len >> 1; + sort_vector_copy (pred, halflen, vec, tmp); + if (1 < len - halflen) + sort_vector_inplace (pred, len - halflen, vec + halflen, vec); + merge_vectors (pred, halflen, tmp, len - halflen, vec + halflen, vec); } -/* Sort VECTOR using PREDICATE, preserving original order of elements - considered as equal. */ +/* Using PRED to compare, sort from LEN-length SRC into DST. + Len must be positive. */ +static void +sort_vector_copy (Lisp_Object pred, ptrdiff_t len, + Lisp_Object src[restrict VLA_ELEMS (len)], + Lisp_Object dest[restrict VLA_ELEMS (len)]) +{ + eassume (0 < len); + ptrdiff_t halflen = len >> 1; + if (halflen < 1) + dest[0] = src[0]; + else + { + if (1 < halflen) + sort_vector_inplace (pred, halflen, src, dest); + if (1 < len - halflen) + sort_vector_inplace (pred, len - halflen, src + halflen, dest); + merge_vectors (pred, halflen, src, len - halflen, src + halflen, dest); + } +} -static Lisp_Object +/* Sort VECTOR in place using PREDICATE, preserving original order of + elements considered as equal. */ + +static void sort_vector (Lisp_Object vector, Lisp_Object predicate) { - ptrdiff_t i; - EMACS_INT len = ASIZE (vector); - Lisp_Object *v = XVECTOR (vector)->contents; - + ptrdiff_t len = ASIZE (vector); if (len < 2) - return vector; - /* Record original index of each element to make qsort stable. */ - for (i = 0; i < len; i++) - v[i] = make_save_int_obj (i, v[i]); - - /* Setup predicate and sort. */ -#ifdef HAVE_QSORT_R -#if defined (DARWIN_OS) || defined (__FreeBSD__) - qsort_r (v, len, word_size, (void *) &predicate, sort_vector_compare); -#elif defined (GNU_LINUX) - qsort_r (v, len, word_size, sort_vector_compare, (void *) &predicate); -#else /* neither darwin/bsd nor gnu/linux */ -#error "check how qsort_r works on your platform" -#endif /* DARWIN_OS || __FreeBSD__ */ -#else /* not HAVE_QSORT_R */ - sort_vector_predicate = predicate; - qsort (v, len, word_size, sort_vector_compare); -#endif /* HAVE_QSORT_R */ - - /* Discard indexes and restore original elements. */ - for (i = 0; i < len; i++) - { - Lisp_Object save = v[i]; - /* Use explicit free to offload GC. */ - v[i] = XSAVE_OBJECT (save, 1); - free_misc (save); - } - return vector; + return; + ptrdiff_t halflen = len >> 1; + Lisp_Object *tmp; + struct gcpro gcpro1, gcpro2, gcpro3; + GCPRO3 (vector, predicate, predicate); + USE_SAFE_ALLOCA; + SAFE_ALLOCA_LISP (tmp, halflen); + for (ptrdiff_t i = 0; i < halflen; i++) + tmp[i] = make_number (0); + gcpro3.var = tmp; + gcpro3.nvars = halflen; + sort_vector_inplace (predicate, len, XVECTOR (vector)->contents, tmp); + UNGCPRO; + SAFE_FREE (); } DEFUN ("sort", Fsort, Ssort, 2, 2, 0, @@ -1990,7 +2016,7 @@ if the first element should sort before the second. */) if (CONSP (seq)) seq = sort_list (seq, predicate); else if (VECTORP (seq)) - seq = sort_vector (seq, predicate); + sort_vector (seq, predicate); else if (!NILP (seq)) wrong_type_argument (Qsequencep, seq); return seq; @@ -2033,8 +2059,7 @@ merge (Lisp_Object org_l1, Lisp_Object org_l2, Lisp_Object pred) Fsetcdr (tail, l1); return value; } - tem = call2 (pred, Fcar (l2), Fcar (l1)); - if (NILP (tem)) + if (inorder (pred, Fcar (l1), Fcar (l2))) { tem = l1; l1 = Fcdr (l1); -- 2.39.5