Commit f9caea82 authored by Paul Eggert's avatar Paul Eggert

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 <vla.h>.
(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
parent 88366fcf
2014-08-30 Paul Eggert <eggert@cs.ucla.edu>
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 <dmantipov@yandex.ru>
* configure.ac (AC_CHECK_FUNCS): Check for qsort_r.
......
2014-08-30 Paul Eggert <eggert@cs.ucla.edu>
Vector-sorting fixes (Bug#18361).
* merge-gnulib (GNULIB_MODULES): Add vla.
2014-08-30 Eli Zaretskii <eliz@gnu.org>
* authors.el (authors): Fix last change so it works for MS-Windows
......
......@@ -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='
......
......@@ -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
......
......@@ -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
......
......@@ -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@
......
/* 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 <http://www.gnu.org/licenses/>.
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
......@@ -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
......
......@@ -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])
......
# 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
])
2014-08-30 Paul Eggert <eggert@cs.ucla.edu>
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 <vla.h>.
(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.
......
......@@ -24,6 +24,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <time.h>
#include <intprops.h>
#include <vla.h>
#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);
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment