procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Vector-sorting fixes.

Browse source 
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
This commit is contained in:
Paul Eggert 2014-08-30 15:59:39 -07:00
parent 88366fcf88
commit f9caea8233
12 changed files with 269 additions and 79 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

12
ChangeLog
View file

@ -1,3 +1,15 @@
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.

5
admin/ChangeLog
View file

@ -1,3 +1,8 @@
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

2
admin/merge-gnulib
View file

@ -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='

2
configure.ac
View file

@ -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

11
lib/gnulib.mk
View file

@ -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

23
lib/stdlib.in.h
View file

@ -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@

27
lib/vla.h Normal file
View file

@ -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 <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

5
m4/gnulib-comp.m4
View file

@ -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

2
m4/stdlib_h.m4
View file

@ -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])

68
m4/vararrays.m4 Normal file
View file

@ -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
])

14
src/ChangeLog
View file

@ -1,5 +1,19 @@
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.

177
src/fns.c
View file

@ -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
/* 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 */
/* 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)
{
bool more, less;
Lisp_Object op, oq, vp, vq;
#ifdef HAVE_QSORT_R
Lisp_Object sort_vector_predicate = *(Lisp_Object *) arg;
#endif
op = *(Lisp_Object *) p;
oq = *(Lisp_Object *) q;
vp = XSAVE_OBJECT (op, 1);
vq = XSAVE_OBJECT (oq, 1);
/* 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)));
return NILP (call2 (pred, b, a));
}
/* Sort VECTOR using PREDICATE, preserving original order of elements
considered as equal. */
/* 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;
static Lisp_Object
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;
}
}
}
}
/* 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);
}
/* 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);
}
}
/* 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);