Re: JSON/YAML/TOML/etc. parsing performance

[Paul Eggert <eggert@cs.ucla.edu>]

[-- Attachment #1: Type: text/plain, Size: 2798 bytes --]

On 10/05/2017 12:12 AM, Eli Zaretskii wrote:
> If ptrdiff_t overflows are reliably diagnosed, then why do we have to
> test for them explicitly in our code, as in the proposed json.c?
They're diagnosed only if one compiles with debugging flags like 
-fsanitize=undefined. And even then the checks are "reliable" only in 
some sense: some overflows at the source level are not caught at the 
machine level even if the code is executed, because the overflows are 
optimized away. So testing a program with -fsanizitize=undefined does 
not guarantee that the same test will avoid ptrdiff_t overflow on some 
other platform.

> AFAIU, ptrdiff_t overflows are the _only_ reason for json.c checks
> whether a size_t value is too large

In the most recent patch I proposed, there were only two such checks; 
there were two other checks for too-large size_t that were fixnum 
checks, not ptrdiff_t checks.

However, I can see that you really don't like those checks. So I tweaked 
the proposed patch to remove them all from json.c. Please see the 
attached 3 patches (the first is just Philipp's patch rebased to 
master). The basic idea here is that json.c should be using xmalloc for 
allocation anyway, for reasons other than size overflow checking. And 
once it uses the Emacs malloc we can make sure that it never allocates 
objects that are too large for ptrdiff_t.

> I'm not arguing for general replacement of ptrdiff_t with size_t, only
> for doing that in those primitives where negative values are a clear
> mistake/bug.

This is exactly where we should be cautious about using unsigned types. 
The longstanding Emacs style is to prefer signed integers, to avoid the 
common typos that occur with unsigned. If we start changing the style, 
these primitives (or people debugging these primitives) often won't be 
able to distinguish buggy from valid-but-enormous cases. And when we 
compile such primitives (or their callers) with -fsanitize=undefined, we 
won't be able to catch integer-overflow bugs automatically at runtime, 
since unsigned integer arithmetic silently wraps around even when 
-fsanitize=undefined is used.

> "kids, don't do that at home -- we are trained professionals" 

I help maintain several GNU programs that use unsigned types for sizes, 
and find that style to be trickier than the style Emacs uses, with 
respect to integer-overflow bugs. I've been gradually changing some of 
the non-Emacs GNU code to use signed types, and the results have been 
encouraging: the code is more readable and more obviously correct. I 
would rather not go back to the unsigned style: although you're right 
that it can be done, it is too error-prone and the errors can lead to 
serious bugs. Even for trained professionals, this particular set of 
acrobatics is best done with a net.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Implement-native-JSON-support-using-Jansson.patch --]
[-- Type: text/x-patch; name="0001-Implement-native-JSON-support-using-Jansson.patch", Size: 32098 bytes --]

From 8a1689de7c9391a84f26cba97ce2b43d2eec893b Mon Sep 17 00:00:00 2001
From: Philipp Stephani <phst@google.com>
Date: Mon, 18 Sep 2017 10:51:39 +0200
Subject: [PATCH 1/3] Implement native JSON support using Jansson

* configure.ac: New option --with-json.

* src/json.c (Fjson_serialize, Fjson_insert, Fjson_parse_string)
(Fjson_parse_buffer): New defuns.
(json_has_prefix, json_has_suffix, json_make_string)
(json_build_string, json_encode, json_out_of_memory, json_parse_error)
(json_release_object, check_string_without_embedded_nulls, json_check)
(lisp_to_json, lisp_to_json_toplevel, lisp_to_json_toplevel_1)
(json_insert, json_insert_callback, json_to_lisp)
(json_read_buffer_callback, Fjson_parse_buffer, define_error): New
helper functions.
(syms_of_json): New file.

* src/lisp.h: Declaration for syms_of_json.

* src/conf_post.h (ATTRIBUTE_WARN_UNUSED_RESULT): New attribute macro.

* src/emacs.c (main): Enable JSON functions.

* src/eval.c (internal_catch_all, internal_catch_all_1): New helper
functions to catch all signals.
(syms_of_eval): Add uninterned symbol to signify out of memory.

* src/Makefile.in (JSON_LIBS, JSON_CFLAGS, JSON_OBJ, EMACS_CFLAGS)
(base_obj, LIBES): Compile json.c if --with-json is enabled.

* test/src/json-tests.el (json-serialize/roundtrip)
(json-serialize/object, json-parse-string/object)
(json-parse-string/string, json-serialize/string)
(json-parse-string/incomplete, json-parse-string/trailing)
(json-parse-buffer/incomplete, json-parse-buffer/trailing): New unit
tests.
---
 configure.ac           |  20 +-
 etc/NEWS               |   7 +
 src/Makefile.in        |  11 +-
 src/conf_post.h        |   6 +
 src/emacs.c            |   4 +
 src/eval.c             |  54 ++++++
 src/json.c             | 517 +++++++++++++++++++++++++++++++++++++++++++++++++
 src/lisp.h             |   6 +
 test/src/json-tests.el |  97 ++++++++++
 9 files changed, 718 insertions(+), 4 deletions(-)
 create mode 100644 src/json.c
 create mode 100644 test/src/json-tests.el

diff --git a/configure.ac b/configure.ac
index eba95e2fb8..a0e25cf631 100644
--- a/configure.ac
+++ b/configure.ac
@@ -348,6 +348,7 @@ AC_DEFUN
 OPTION_DEFAULT_OFF([cairo],[compile with Cairo drawing (experimental)])
 OPTION_DEFAULT_ON([xml2],[don't compile with XML parsing support])
 OPTION_DEFAULT_ON([imagemagick],[don't compile with ImageMagick image support])
+OPTION_DEFAULT_ON([json], [don't compile with native JSON support])
 
 OPTION_DEFAULT_ON([xft],[don't use XFT for anti aliased fonts])
 OPTION_DEFAULT_ON([libotf],[don't use libotf for OpenType font support])
@@ -2856,6 +2857,22 @@ AC_DEFUN
 AC_SUBST(LIBSYSTEMD_LIBS)
 AC_SUBST(LIBSYSTEMD_CFLAGS)
 
+HAVE_JSON=no
+JSON_OBJ=
+
+if test "${with_json}" = yes; then
+  EMACS_CHECK_MODULES([JSON], [jansson >= 2.5],
+    [HAVE_JSON=yes], [HAVE_JSON=no])
+  if test "${HAVE_JSON}" = yes; then
+    AC_DEFINE(HAVE_JSON, 1, [Define if using Jansson.])
+    JSON_OBJ=json.o
+  fi
+fi
+
+AC_SUBST(JSON_LIBS)
+AC_SUBST(JSON_CFLAGS)
+AC_SUBST(JSON_OBJ)
+
 NOTIFY_OBJ=
 NOTIFY_SUMMARY=no
 
@@ -5368,7 +5385,7 @@ AC_DEFUN
 for opt in XAW3D XPM JPEG TIFF GIF PNG RSVG CAIRO IMAGEMAGICK SOUND GPM DBUS \
   GCONF GSETTINGS NOTIFY ACL LIBSELINUX GNUTLS LIBXML2 FREETYPE M17N_FLT \
   LIBOTF XFT ZLIB TOOLKIT_SCROLL_BARS X_TOOLKIT OLDXMENU X11 NS MODULES \
-  XWIDGETS LIBSYSTEMD CANNOT_DUMP LCMS2; do
+  XWIDGETS LIBSYSTEMD JSON CANNOT_DUMP LCMS2; do
 
     case $opt in
       CANNOT_DUMP) eval val=\${$opt} ;;
@@ -5418,6 +5435,7 @@ AC_DEFUN
   Does Emacs use -lotf?                                   ${HAVE_LIBOTF}
   Does Emacs use -lxft?                                   ${HAVE_XFT}
   Does Emacs use -lsystemd?                               ${HAVE_LIBSYSTEMD}
+  Does Emacs use -ljansson?                               ${HAVE_JSON}
   Does Emacs directly use zlib?                           ${HAVE_ZLIB}
   Does Emacs have dynamic modules support?                ${HAVE_MODULES}
   Does Emacs use toolkit scroll bars?                     ${USE_TOOLKIT_SCROLL_BARS}
diff --git a/etc/NEWS b/etc/NEWS
index 15661808c7..81586ceb97 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -25,6 +25,13 @@ When you add a new item, use the appropriate mark if you are sure it applies,
 \f
 * Installation Changes in Emacs 27.1
 
+** The new configure option '--with-json' adds support for JSON using
+the Jansson library.  It is on by default; use 'configure
+--with-json=no' to build without Jansson support.  The new JSON
+functions 'json-serialize', 'json-insert', 'json-parse-string', and
+'json-parse-buffer' are typically much faster than their Lisp
+counterparts from json.el.
+
 \f
 * Startup Changes in Emacs 27.1
 
diff --git a/src/Makefile.in b/src/Makefile.in
index 9a8c9c85f0..b395627893 100644
--- a/src/Makefile.in
+++ b/src/Makefile.in
@@ -312,6 +312,10 @@ LIBGNUTLS_CFLAGS =
 LIBSYSTEMD_LIBS = @LIBSYSTEMD_LIBS@
 LIBSYSTEMD_CFLAGS = @LIBSYSTEMD_CFLAGS@
 
+JSON_LIBS = @JSON_LIBS@
+JSON_CFLAGS = @JSON_CFLAGS@
+JSON_OBJ = @JSON_OBJ@
+
 INTERVALS_H = dispextern.h intervals.h composite.h
 
 GETLOADAVG_LIBS = @GETLOADAVG_LIBS@
@@ -363,7 +367,7 @@ EMACS_CFLAGS=
   $(WEBKIT_CFLAGS) \
   $(SETTINGS_CFLAGS) $(FREETYPE_CFLAGS) $(FONTCONFIG_CFLAGS) \
   $(LIBOTF_CFLAGS) $(M17N_FLT_CFLAGS) $(DEPFLAGS) \
-  $(LIBSYSTEMD_CFLAGS) \
+  $(LIBSYSTEMD_CFLAGS) $(JSON_CFLAGS) \
   $(LIBGNUTLS_CFLAGS) $(NOTIFY_CFLAGS) $(CAIRO_CFLAGS) \
   $(WERROR_CFLAGS)
 ALL_CFLAGS = $(EMACS_CFLAGS) $(WARN_CFLAGS) $(CFLAGS)
@@ -397,7 +401,7 @@ base_obj =
 	thread.o systhread.o \
 	$(if $(HYBRID_MALLOC),sheap.o) \
 	$(MSDOS_OBJ) $(MSDOS_X_OBJ) $(NS_OBJ) $(CYGWIN_OBJ) $(FONT_OBJ) \
-	$(W32_OBJ) $(WINDOW_SYSTEM_OBJ) $(XGSELOBJ)
+	$(W32_OBJ) $(WINDOW_SYSTEM_OBJ) $(XGSELOBJ) $(JSON_OBJ)
 obj = $(base_obj) $(NS_OBJC_OBJ)
 
 ## Object files used on some machine or other.
@@ -493,7 +497,8 @@ LIBES =
    $(LIBS_TERMCAP) $(GETLOADAVG_LIBS) $(SETTINGS_LIBS) $(LIBSELINUX_LIBS) \
    $(FREETYPE_LIBS) $(FONTCONFIG_LIBS) $(LIBOTF_LIBS) $(M17N_FLT_LIBS) \
    $(LIBGNUTLS_LIBS) $(LIB_PTHREAD) $(GETADDRINFO_A_LIBS) $(LIBLCMS2) \
-   $(NOTIFY_LIBS) $(LIB_MATH) $(LIBZ) $(LIBMODULES) $(LIBSYSTEMD_LIBS)
+   $(NOTIFY_LIBS) $(LIB_MATH) $(LIBZ) $(LIBMODULES) $(LIBSYSTEMD_LIBS) \
+   $(JSON_LIBS)
 
 ## FORCE it so that admin/unidata can decide whether these files
 ## are up-to-date.  Although since charprop depends on bootstrap-emacs,
diff --git a/src/conf_post.h b/src/conf_post.h
index febdb8b8bf..1a7f51fa51 100644
--- a/src/conf_post.h
+++ b/src/conf_post.h
@@ -338,6 +338,12 @@ extern int emacs_setenv_TZ (char const *);
 # define ATTRIBUTE_NO_SANITIZE_ADDRESS
 #endif
 
+#if __has_attribute (warn_unused_result)
+# define ATTRIBUTE_WARN_UNUSED_RESULT __attribute__ ((__warn_unused_result__))
+#else
+# define ATTRIBUTE_WARN_UNUSED_RESULT
+#endif
+
 /* gcc -fsanitize=address does not work with vfork in Fedora 25 x86-64.
    For now, assume that this problem occurs on all platforms.  */
 #if ADDRESS_SANITIZER && !defined vfork
diff --git a/src/emacs.c b/src/emacs.c
index 0fe7d9113b..39761016ef 100644
--- a/src/emacs.c
+++ b/src/emacs.c
@@ -1610,6 +1610,10 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem
       syms_of_threads ();
       syms_of_profiler ();
 
+#ifdef HAVE_JSON
+      syms_of_json ();
+#endif
+
       keys_of_casefiddle ();
       keys_of_cmds ();
       keys_of_buffer ();
diff --git a/src/eval.c b/src/eval.c
index acda64e7f0..11804d1819 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -1416,6 +1416,57 @@ internal_condition_case_n (Lisp_Object (*bfun) (ptrdiff_t, Lisp_Object *),
     }
 }
 
+static Lisp_Object
+internal_catch_all_1 (Lisp_Object (*function) (void *), void *argument)
+{
+  struct handler *c = push_handler_nosignal (Qt, CATCHER_ALL);
+  if (c == NULL)
+    return Qcatch_all_memory_full;
+
+  if (sys_setjmp (c->jmp) == 0)
+    {
+      Lisp_Object val = function (argument);
+      eassert (handlerlist == c);
+      handlerlist = c->next;
+      return val;
+    }
+  else
+    {
+      eassert (handlerlist == c);
+      Lisp_Object val = c->val;
+      handlerlist = c->next;
+      Fsignal (Qno_catch, val);
+    }
+}
+
+/* Like a combination of internal_condition_case_1 and internal_catch.
+   Catches all signals and throws.  Never exits nonlocally; returns
+   Qcatch_all_memory_full if no handler could be allocated.  */
+
+Lisp_Object
+internal_catch_all (Lisp_Object (*function) (void *), void *argument,
+                    Lisp_Object (*handler) (Lisp_Object))
+{
+  struct handler *c = push_handler_nosignal (Qt, CONDITION_CASE);
+  if (c == NULL)
+    return Qcatch_all_memory_full;
+
+  if (sys_setjmp (c->jmp) == 0)
+    {
+      Lisp_Object val = internal_catch_all_1 (function, argument);
+      eassert (handlerlist == c);
+      handlerlist = c->next;
+      return val;
+    }
+  else
+    {
+      eassert (handlerlist == c);
+      Lisp_Object val = c->val;
+      handlerlist = c->next;
+      return handler (val);
+    }
+}
+
 struct handler *
 push_handler (Lisp_Object tag_ch_val, enum handlertype handlertype)
 {
@@ -4065,6 +4116,9 @@ alist of active lexical bindings.  */);
 
   inhibit_lisp_code = Qnil;
 
+  DEFSYM (Qcatch_all_memory_full, "catch-all-memory-full");
+  Funintern (Qcatch_all_memory_full, Qnil);
+
   defsubr (&Sor);
   defsubr (&Sand);
   defsubr (&Sif);
diff --git a/src/json.c b/src/json.c
new file mode 100644
index 0000000000..79be55bd54
--- /dev/null
+++ b/src/json.c
@@ -0,0 +1,517 @@
+/* JSON parsing and serialization.
+
+Copyright (C) 2017 Free Software Foundation, Inc.
+
+This file is part of GNU Emacs.
+
+GNU Emacs 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.
+
+GNU Emacs 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 GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.  */
+
+#include <config.h>
+
+#include <stddef.h>
+#include <stdint.h>
+
+#include <jansson.h>
+
+#include "lisp.h"
+#include "buffer.h"
+#include "coding.h"
+
+static bool
+json_has_prefix (const char *string, const char *prefix)
+{
+  size_t string_len = strlen (string);
+  size_t prefix_len = strlen (prefix);
+  return string_len >= prefix_len && memcmp (string, prefix, prefix_len) == 0;
+}
+
+static bool
+json_has_suffix (const char *string, const char *suffix)
+{
+  size_t string_len = strlen (string);
+  size_t suffix_len = strlen (suffix);
+  return string_len >= suffix_len
+    && memcmp (string + string_len - suffix_len, suffix, suffix_len) == 0;
+}
+
+static Lisp_Object
+json_make_string (const char *data, ptrdiff_t size)
+{
+  return make_specified_string (data, -1, size, true);
+}
+
+static Lisp_Object
+json_build_string (const char *data)
+{
+  size_t size = strlen (data);
+  eassert (size < PTRDIFF_MAX);
+  return json_make_string (data, size);
+}
+
+static Lisp_Object
+json_encode (Lisp_Object string)
+{
+  return code_convert_string (string, Qutf_8_unix, Qt, true, true, true);
+}
+
+static _Noreturn void
+json_out_of_memory (void)
+{
+  xsignal0 (Qjson_out_of_memory);
+}
+
+static _Noreturn void
+json_parse_error (const json_error_t *error)
+{
+  Lisp_Object symbol;
+  if (json_has_suffix (error->text, "expected near end of file"))
+    symbol = Qjson_end_of_file;
+  else if (json_has_prefix (error->text, "end of file expected"))
+    symbol = Qjson_trailing_content;
+  else
+    symbol = Qjson_parse_error;
+  xsignal (symbol,
+           list5 (json_build_string (error->text),
+                  json_build_string (error->source), make_natnum (error->line),
+                  make_natnum (error->column), make_natnum (error->position)));
+}
+
+static void
+json_release_object (void *object)
+{
+  json_decref (object);
+}
+
+static void
+check_string_without_embedded_nulls (Lisp_Object object)
+{
+  CHECK_STRING (object);
+  CHECK_TYPE (memchr (SDATA (object), '\0', SBYTES (object)) == NULL,
+              Qstring_without_embedded_nulls_p, object);
+}
+
+static ATTRIBUTE_WARN_UNUSED_RESULT json_t *
+json_check (json_t *object)
+{
+  if (object == NULL)
+    json_out_of_memory ();
+  return object;
+}
+
+static json_t *lisp_to_json (Lisp_Object) ATTRIBUTE_WARN_UNUSED_RESULT;
+
+/* This returns Lisp_Object so we can use unbind_to.  The return value
+   is always nil.  */
+
+static _GL_ARG_NONNULL ((2)) Lisp_Object
+lisp_to_json_toplevel_1 (Lisp_Object lisp, json_t **json)
+{
+  if (VECTORP (lisp))
+    {
+      ptrdiff_t size = ASIZE (lisp);
+      eassert (size >= 0);
+      if (size > SIZE_MAX)
+        xsignal1 (Qoverflow_error, build_string ("vector is too long"));
+      *json = json_check (json_array ());
+      ptrdiff_t count = SPECPDL_INDEX ();
+      record_unwind_protect_ptr (json_release_object, json);
+      for (ptrdiff_t i = 0; i < size; ++i)
+        {
+          int status
+            = json_array_append_new (*json, lisp_to_json (AREF (lisp, i)));
+          if (status == -1)
+            json_out_of_memory ();
+          eassert (status == 0);
+        }
+      eassert (json_array_size (*json) == size);
+      clear_unwind_protect (count);
+      return unbind_to (count, Qnil);
+    }
+  else if (HASH_TABLE_P (lisp))
+    {
+      struct Lisp_Hash_Table *h = XHASH_TABLE (lisp);
+      *json = json_check (json_object ());
+      ptrdiff_t count = SPECPDL_INDEX ();
+      record_unwind_protect_ptr (json_release_object, *json);
+      for (ptrdiff_t i = 0; i < HASH_TABLE_SIZE (h); ++i)
+        if (!NILP (HASH_HASH (h, i)))
+          {
+            Lisp_Object key = json_encode (HASH_KEY (h, i));
+            /* We can’t specify the length, so the string must be
+               null-terminated.  */
+            check_string_without_embedded_nulls (key);
+            int status = json_object_set_new (*json, SSDATA (key),
+                                              lisp_to_json (HASH_VALUE (h, i)));
+            if (status == -1)
+              json_out_of_memory ();
+            eassert (status == 0);
+          }
+      clear_unwind_protect (count);
+      return unbind_to (count, Qnil);
+    }
+  wrong_type_argument (Qjson_value_p, lisp);
+}
+
+static ATTRIBUTE_WARN_UNUSED_RESULT json_t *
+lisp_to_json_toplevel (Lisp_Object lisp)
+{
+  if (++lisp_eval_depth > max_lisp_eval_depth)
+    xsignal0 (Qjson_object_too_deep);
+  json_t *json;
+  lisp_to_json_toplevel_1 (lisp, &json);
+  --lisp_eval_depth;
+  return json;
+}
+
+static ATTRIBUTE_WARN_UNUSED_RESULT json_t *
+lisp_to_json (Lisp_Object lisp)
+{
+  if (EQ (lisp, QCnull))
+    return json_check (json_null ());
+  else if (EQ (lisp, QCfalse))
+    return json_check (json_false ());
+  else if (EQ (lisp, Qt))
+    return json_check (json_true ());
+  else if (INTEGERP (lisp))
+    {
+      CHECK_TYPE_RANGED_INTEGER (json_int_t, lisp);
+      return json_check (json_integer (XINT (lisp)));
+    }
+  else if (FLOATP (lisp))
+    return json_check (json_real (XFLOAT_DATA (lisp)));
+  else if (STRINGP (lisp))
+    {
+      Lisp_Object encoded = json_encode (lisp);
+      ptrdiff_t size = SBYTES (encoded);
+      eassert (size >= 0);
+      if (size > SIZE_MAX)
+        xsignal1 (Qoverflow_error, build_string ("string is too long"));
+      return json_check (json_stringn (SSDATA (encoded), size));
+    }
+
+  /* LISP now must be a vector or hashtable.  */
+  return lisp_to_json_toplevel (lisp);
+}
+
+DEFUN ("json-serialize", Fjson_serialize, Sjson_serialize, 1, 1, NULL,
+       doc: /* Return the JSON representation of OBJECT as a string.
+OBJECT must be a vector or hashtable, and its elements can recursively
+contain `:null', `:false', t, numbers, strings, or other vectors and
+hashtables.  `:null', `:false', and t will be converted to JSON null,
+false, and true values, respectively.  Vectors will be converted to
+JSON arrays, and hashtables to JSON objects.  Hashtable keys must be
+strings without embedded null characters and must be unique within
+each object.  */)
+  (Lisp_Object object)
+{
+  ptrdiff_t count = SPECPDL_INDEX ();
+
+  json_t *json = lisp_to_json_toplevel (object);
+  record_unwind_protect_ptr (json_release_object, json);
+
+  char *string = json_dumps (json, JSON_COMPACT);
+  if (string == NULL)
+    json_out_of_memory ();
+  record_unwind_protect_ptr (free, string);
+
+  return unbind_to (count, json_build_string (string));
+}
+
+struct json_buffer_and_size
+{
+  const char *buffer;
+  size_t size;
+};
+
+static Lisp_Object
+json_insert (void *data)
+{
+  const struct json_buffer_and_size *buffer_and_size = data;
+  if (buffer_and_size->size > PTRDIFF_MAX)
+    xsignal1 (Qoverflow_error, build_string ("buffer too large"));
+  insert (buffer_and_size->buffer, buffer_and_size->size);
+  return Qnil;
+}
+
+struct json_insert_data
+{
+  /* nil if json_insert succeeded, otherwise the symbol
+     Qcatch_all_memory_full or a cons (ERROR-SYMBOL . ERROR-DATA).  */
+  Lisp_Object error;
+};
+
+static int
+json_insert_callback (const char *buffer, size_t size, void *data)
+{
+  /* This function may not exit nonlocally.  */
+  struct json_insert_data *d = data;
+  struct json_buffer_and_size buffer_and_size
+    = {.buffer = buffer, .size = size};
+  d->error = internal_catch_all (json_insert, &buffer_and_size, Fidentity);
+  return NILP (d->error) ? 0 : -1;
+}
+
+DEFUN ("json-insert", Fjson_insert, Sjson_insert, 1, 1, NULL,
+       doc: /* Insert the JSON representation of OBJECT before point.
+This is the same as (insert (json-serialize OBJECT)), but potentially
+faster.  See the function `json-serialize' for allowed values of
+OBJECT.  */)
+  (Lisp_Object object)
+{
+  ptrdiff_t count = SPECPDL_INDEX ();
+
+  json_t *json = lisp_to_json (object);
+  record_unwind_protect_ptr (json_release_object, json);
+
+  struct json_insert_data data;
+  int status
+    = json_dump_callback (json, json_insert_callback, &data, JSON_COMPACT);
+  if (status == -1)
+    {
+      if (CONSP (data.error))
+        xsignal (XCAR (data.error), XCDR (data.error));
+      else
+        json_out_of_memory ();
+    }
+  eassert (status == 0);
+  eassert (NILP (data.error));
+  return unbind_to (count, Qnil);
+}
+
+static _GL_ARG_NONNULL ((1)) Lisp_Object
+json_to_lisp (json_t *json)
+{
+  switch (json_typeof (json))
+    {
+    case JSON_NULL:
+      return QCnull;
+    case JSON_FALSE:
+      return QCfalse;
+    case JSON_TRUE:
+      return Qt;
+    case JSON_INTEGER:
+      {
+        json_int_t value = json_integer_value (json);
+        if (FIXNUM_OVERFLOW_P (value))
+          xsignal1 (Qoverflow_error,
+                    build_string ("JSON integer is too large"));
+        return make_number (value);
+      }
+    case JSON_REAL:
+      return make_float (json_real_value (json));
+    case JSON_STRING:
+      {
+        size_t size = json_string_length (json);
+        if (FIXNUM_OVERFLOW_P (size))
+          xsignal1 (Qoverflow_error, build_string ("JSON string is too long"));
+        return json_make_string (json_string_value (json), size);
+      }
+    case JSON_ARRAY:
+      {
+        if (++lisp_eval_depth > max_lisp_eval_depth)
+          xsignal0 (Qjson_object_too_deep);
+        size_t size = json_array_size (json);
+        if (FIXNUM_OVERFLOW_P (size))
+          xsignal1 (Qoverflow_error, build_string ("JSON array is too long"));
+        Lisp_Object result = Fmake_vector (make_natnum (size), Qunbound);
+        for (ptrdiff_t i = 0; i < size; ++i)
+          ASET (result, i,
+                json_to_lisp (json_array_get (json, i)));
+        --lisp_eval_depth;
+        return result;
+      }
+    case JSON_OBJECT:
+      {
+        if (++lisp_eval_depth > max_lisp_eval_depth)
+          xsignal0 (Qjson_object_too_deep);
+        size_t size = json_object_size (json);
+        if (FIXNUM_OVERFLOW_P (size))
+          xsignal1 (Qoverflow_error,
+                    build_string ("JSON object has too many elements"));
+        Lisp_Object result = CALLN (Fmake_hash_table, QCtest, Qequal,
+                                    QCsize, make_natnum (size));
+        struct Lisp_Hash_Table *h = XHASH_TABLE (result);
+        const char *key_str;
+        json_t *value;
+        json_object_foreach (json, key_str, value)
+          {
+            Lisp_Object key = json_build_string (key_str);
+            EMACS_UINT hash;
+            ptrdiff_t i = hash_lookup (h, key, &hash);
+            eassert (i < 0);
+            hash_put (h, key, json_to_lisp (value), hash);
+          }
+        --lisp_eval_depth;
+        return result;
+      }
+    }
+  /* Can’t get here.  */
+  emacs_abort ();
+}
+
+DEFUN ("json-parse-string", Fjson_parse_string, Sjson_parse_string, 1, 1, NULL,
+       doc: /* Parse the JSON STRING into a Lisp object.
+This is essentially the reverse operation of `json-serialize', which
+see.  The returned object will be a vector or hashtable.  Its elements
+will be `:null', `:false', t, numbers, strings, or further vectors and
+hashtables.  If there are duplicate keys in an object, all but the
+last one are ignored.  If STRING doesn't contain a valid JSON object,
+an error of type `json-parse-error' is signaled.  */)
+  (Lisp_Object string)
+{
+  ptrdiff_t count = SPECPDL_INDEX ();
+  Lisp_Object encoded = json_encode (string);
+  check_string_without_embedded_nulls (encoded);
+
+  json_error_t error;
+  json_t *object = json_loads (SSDATA (encoded), 0, &error);
+  if (object == NULL)
+    json_parse_error (&error);
+
+  /* Avoid leaking the object in case of further errors.  */
+  if (object != NULL)
+    record_unwind_protect_ptr (json_release_object, object);
+
+  return unbind_to (count, json_to_lisp (object));
+}
+
+struct json_read_buffer_data
+{
+  ptrdiff_t point;
+};
+
+static size_t
+json_read_buffer_callback (void *buffer, size_t buflen, void *data)
+{
+  struct json_read_buffer_data *d = data;
+
+  /* First, parse from point to the gap or the end of the accessible
+     portion, whatever is closer.  */
+  ptrdiff_t point = d->point;
+  ptrdiff_t end;
+  {
+    bool overflow = INT_ADD_WRAPV (BUFFER_CEILING_OF (point), 1, &end);
+    eassert (!overflow);
+  }
+  size_t count;
+  {
+    bool overflow = INT_SUBTRACT_WRAPV (end, point, &count);
+    eassert (!overflow);
+  }
+  if (buflen < count)
+    count = buflen;
+  memcpy (buffer, BYTE_POS_ADDR (point), count);
+  {
+    bool overflow = INT_ADD_WRAPV (d->point, count, &d->point);
+    eassert (!overflow);
+  }
+  return count;
+}
+
+DEFUN ("json-parse-buffer", Fjson_parse_buffer, Sjson_parse_buffer,
+       0, 0, NULL,
+       doc: /* Read JSON object from current buffer starting at point.
+This is similar to `json-parse-string', which see.  Move point after
+the end of the object if parsing was successful.  On error, point is
+not moved.  */)
+  (void)
+{
+  ptrdiff_t count = SPECPDL_INDEX ();
+
+  ptrdiff_t point = PT_BYTE;
+  struct json_read_buffer_data data = {.point = point};
+  json_error_t error;
+  json_t *object = json_load_callback (json_read_buffer_callback, &data,
+                                       JSON_DISABLE_EOF_CHECK, &error);
+
+  if (object == NULL)
+    json_parse_error (&error);
+
+  /* Avoid leaking the object in case of further errors.  */
+  record_unwind_protect_ptr (json_release_object, object);
+
+  /* Convert and then move point only if everything succeeded.  */
+  Lisp_Object lisp = json_to_lisp (object);
+
+  {
+    /* Adjust point by how much we just read.  Do this here because
+       tokener->char_offset becomes incorrect below.  */
+    bool overflow = INT_ADD_WRAPV (point, error.position, &point);
+    eassert (!overflow);
+    eassert (point <= ZV_BYTE);
+    SET_PT_BOTH (BYTE_TO_CHAR (point), point);
+  }
+
+  return unbind_to (count, lisp);
+}
+
+/* Simplified version of ‘define-error’ that works with pure
+   objects.  */
+
+static void
+define_error (Lisp_Object name, const char *message, Lisp_Object parent)
+{
+  eassert (SYMBOLP (name));
+  eassert (SYMBOLP (parent));
+  Lisp_Object parent_conditions = Fget (parent, Qerror_conditions);
+  eassert (CONSP (parent_conditions));
+  eassert (!NILP (Fmemq (parent, parent_conditions)));
+  eassert (NILP (Fmemq (name, parent_conditions)));
+  Fput (name, Qerror_conditions, pure_cons (name, parent_conditions));
+  Fput (name, Qerror_message, build_pure_c_string (message));
+}
+
+void
+syms_of_json (void)
+{
+  DEFSYM (QCnull, ":null");
+  DEFSYM (QCfalse, ":false");
+
+  DEFSYM (Qstring_without_embedded_nulls_p, "string-without-embedded-nulls-p");
+  DEFSYM (Qjson_value_p, "json-value-p");
+
+  DEFSYM (Qutf_8_unix, "utf-8-unix");
+
+  DEFSYM (Qjson_error, "json-error");
+  DEFSYM (Qjson_out_of_memory, "json-out-of-memory");
+  DEFSYM (Qjson_parse_error, "json-parse-error");
+  DEFSYM (Qjson_end_of_file, "json-end-of-file");
+  DEFSYM (Qjson_trailing_content, "json-trailing-content");
+  DEFSYM (Qjson_object_too_deep, "json-object-too-deep");
+  define_error (Qjson_error, "generic JSON error", Qerror);
+  define_error (Qjson_out_of_memory, "no free memory for creating JSON object",
+                Qjson_error);
+  define_error (Qjson_parse_error, "could not parse JSON stream",
+                Qjson_error);
+  define_error (Qjson_end_of_file, "end of JSON stream", Qjson_parse_error);
+  define_error (Qjson_trailing_content, "trailing content after JSON stream",
+                Qjson_parse_error);
+  define_error (Qjson_object_too_deep,
+                "object cyclic or Lisp evaluation too deep", Qjson_error);
+
+  DEFSYM (Qpure, "pure");
+  DEFSYM (Qside_effect_free, "side-effect-free");
+
+  DEFSYM (Qjson_serialize, "json-serialize");
+  DEFSYM (Qjson_parse_string, "json-parse-string");
+  Fput (Qjson_serialize, Qpure, Qt);
+  Fput (Qjson_serialize, Qside_effect_free, Qt);
+  Fput (Qjson_parse_string, Qpure, Qt);
+  Fput (Qjson_parse_string, Qside_effect_free, Qt);
+
+  defsubr (&Sjson_serialize);
+  defsubr (&Sjson_insert);
+  defsubr (&Sjson_parse_string);
+  defsubr (&Sjson_parse_buffer);
+}
diff --git a/src/lisp.h b/src/lisp.h
index 680c25d4c4..43d8846619 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -3440,6 +3440,11 @@ extern int x_bitmap_mask (struct frame *, ptrdiff_t);
 extern void reset_image_types (void);
 extern void syms_of_image (void);
 
+#ifdef HAVE_JSON
+/* Defined in json.c.  */
+extern void syms_of_json (void);
+#endif
+
 /* Defined in insdel.c.  */
 extern void move_gap_both (ptrdiff_t, ptrdiff_t);
 extern _Noreturn void buffer_overflow (void);
@@ -3863,6 +3868,7 @@ extern Lisp_Object internal_condition_case_2 (Lisp_Object (*) (Lisp_Object, Lisp
 extern Lisp_Object internal_condition_case_n
     (Lisp_Object (*) (ptrdiff_t, Lisp_Object *), ptrdiff_t, Lisp_Object *,
      Lisp_Object, Lisp_Object (*) (Lisp_Object, ptrdiff_t, Lisp_Object *));
+extern Lisp_Object internal_catch_all (Lisp_Object (*) (void *), void *, Lisp_Object (*) (Lisp_Object));
 extern struct handler *push_handler (Lisp_Object, enum handlertype);
 extern struct handler *push_handler_nosignal (Lisp_Object, enum handlertype);
 extern void specbind (Lisp_Object, Lisp_Object);
diff --git a/test/src/json-tests.el b/test/src/json-tests.el
new file mode 100644
index 0000000000..8820c682ba
--- /dev/null
+++ b/test/src/json-tests.el
@@ -0,0 +1,97 @@
+;;; json-tests.el --- unit tests for json.c          -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2017 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs 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.
+
+;; GNU Emacs 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 GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Unit tests for src/json.c.
+
+;;; Code:
+
+(require 'cl-lib)
+(require 'map)
+
+(ert-deftest json-serialize/roundtrip ()
+  (let ((lisp [:null :false t 0 123 -456 3.75 "foo"])
+        (json "[null,false,true,0,123,-456,3.75,\"foo\"]"))
+    (should (equal (json-serialize lisp) json))
+    (with-temp-buffer
+      (json-insert lisp)
+      (should (equal (buffer-string) json))
+      (should (eobp)))
+    (should (equal (json-parse-string json) lisp))
+    (with-temp-buffer
+      (insert json)
+      (goto-char 1)
+      (should (equal (json-parse-buffer) lisp))
+      (should (eobp)))))
+
+(ert-deftest json-serialize/object ()
+  (let ((table (make-hash-table :test #'equal)))
+    (puthash "abc" [1 2 t] table)
+    (puthash "def" :null table)
+    (should (equal (json-serialize table)
+                   "{\"abc\":[1,2,true],\"def\":null}"))))
+
+(ert-deftest json-parse-string/object ()
+  (let ((actual
+         (json-parse-string
+          "{ \"abc\" : [1, 2, true], \"def\" : null, \"abc\" : [9, false] }\n")))
+    (should (hash-table-p actual))
+    (should (equal (hash-table-count actual) 2))
+    (should (equal (cl-sort (map-pairs actual) #'string< :key #'car)
+                   '(("abc" . [9 :false]) ("def" . :null))))))
+
+(ert-deftest json-parse-string/string ()
+  (should-error (json-parse-string "[\"formfeed\f\"]") :type 'json-parse-error)
+  (should (equal (json-parse-string "[\"foo \\\"bar\\\"\"]") ["foo \"bar\""]))
+  (should (equal (json-parse-string "[\"abcαβγ\"]") ["abcαβγ"]))
+  (should (equal (json-parse-string "[\"\\nasd\\u0444\\u044b\\u0432fgh\\t\"]")
+                 ["\nasdфывfgh\t"]))
+  (should (equal (json-parse-string "[\"\\uD834\\uDD1E\"]") ["\U0001D11E"]))
+  (should-error (json-parse-string "foo") :type 'json-parse-error))
+
+(ert-deftest json-serialize/string ()
+  (should (equal (json-serialize ["foo"]) "[\"foo\"]"))
+  (should (equal (json-serialize ["a\n\fb"]) "[\"a\\n\\fb\"]"))
+  (should (equal (json-serialize ["\nasdфыв\u001f\u007ffgh\t"])
+                 "[\"\\nasdфыв\\u001F\u007ffgh\\t\"]")))
+
+(ert-deftest json-parse-string/incomplete ()
+  (should-error (json-parse-string "[123") :type 'json-end-of-file))
+
+(ert-deftest json-parse-string/trailing ()
+  (should-error (json-parse-string "[123] [456]") :type 'json-trailing-content))
+
+(ert-deftest json-parse-buffer/incomplete ()
+  (with-temp-buffer
+    (insert "[123")
+    (goto-char 1)
+    (should-error (json-parse-buffer) :type 'json-end-of-file)
+    (should (bobp))))
+
+(ert-deftest json-parse-buffer/trailing ()
+  (with-temp-buffer
+    (insert "[123] [456]")
+    (goto-char 1)
+    (should (equal (json-parse-buffer) [123]))
+    (should-not (bobp))
+    (should (looking-at-p (rx " [456]" eos)))))
+
+(provide 'json-tests)
+;;; json-tests.el ends here
-- 
2.13.6


[-- Attachment #3: 0002-Do-not-malloc-more-than-PTRDIFF_MAX.patch --]
[-- Type: text/x-patch, Size: 1181 bytes --]

From c27ea3054d37a38c64f339e30044b1f463b9affe Mon Sep 17 00:00:00 2001
From: Paul Eggert <eggert@cs.ucla.edu>
Date: Thu, 5 Oct 2017 17:59:07 -0700
Subject: [PATCH 2/3] Do not malloc more than PTRDIFF_MAX

* src/alloc.c (lmalloc, lrealloc): Do not allocate objects
containing more than PTRDIFF_MAX bytes, as they would
cause pointer subtraction to stop working.  Much of
Emacs already checks for this; this change closes a
couple of loopholes.
---
 src/alloc.c | 12 ++++++++++++
 1 file changed, 12 insertions(+)

diff --git a/src/alloc.c b/src/alloc.c
index 2e6399e7f8..ed482c88f2 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -1440,6 +1440,12 @@ laligned (void *p, size_t size)
 static void *
 lmalloc (size_t size)
 {
+  if (PTRDIFF_MAX < size)
+    {
+      errno = ENOMEM;
+      return NULL;
+    }
+
 #if USE_ALIGNED_ALLOC
   if (! MALLOC_IS_GC_ALIGNED && size % GCALIGNMENT == 0)
     return aligned_alloc (GCALIGNMENT, size);
@@ -1460,6 +1466,12 @@ lmalloc (size_t size)
 static void *
 lrealloc (void *p, size_t size)
 {
+  if (PTRDIFF_MAX < size)
+    {
+      errno = ENOMEM;
+      return NULL;
+    }
+
   while (true)
     {
       p = realloc (p, size);
-- 
2.13.6


[-- Attachment #4: 0003-Minor-JSON-cleanups-mostly-for-overflow.patch --]
[-- Type: text/x-patch, Size: 10377 bytes --]

From 991b22ef18152fb0f2238f25998bb141951ab2cd Mon Sep 17 00:00:00 2001
From: Paul Eggert <eggert@cs.ucla.edu>
Date: Wed, 4 Oct 2017 18:38:07 -0700
Subject: [PATCH 3/3] Minor JSON cleanups, mostly for overflow

Tell Jansson to use the Emacs allocators, to avoid problems
with objects containing more than PTRDIFF_MAX bytes,
along with other problems.  Also, fix some other
minor integer-overflow problems.
* src/emacs.c (main) [HAVE_JSON]: Call init_json.
* src/json.c (json_has_prefix): Simplify via strncmp.
(json_has_suffix): Indent a la GNU.
(json_has_suffix, struct json_buffer_and_size):
Use ptrdiff_t instead of size_t where either will do.
(json_build_string, lisp_to_json_toplevel_1, lisp_to_json)
(json_insert, json_to_lisp, json_read_buffer_callback)
(define_error): Remove useless or no-longer-needed checks.
(json_out_of_memory, json_to_lisp): Just call memory_full.
(check_string_without_embedded_nulls): Use strlen, not memchr;
it is typically faster.
(lisp_to_json_toplevel_1, json_to_lisp): Do not bother with
_GL_ARG_NONNULL on static functions; it is not worth the trouble.
(json_to_lisp): Just signal overflow error, to be consistent with
other signalers.  Use allocate_vector instead of Fmake_vector,
to avoid need for initializing vector twice.  Use make_hash_table
instead of Fmake_hash_table, as it is a bit simpler.
(init_json): New function.
---
 src/emacs.c |   4 +++
 src/json.c  | 105 +++++++++++++++++++++---------------------------------------
 src/lisp.h  |   1 +
 3 files changed, 42 insertions(+), 68 deletions(-)

diff --git a/src/emacs.c b/src/emacs.c
index 39761016ef..9f635acdbc 100644
--- a/src/emacs.c
+++ b/src/emacs.c
@@ -1271,6 +1271,10 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem
   build_details = ! argmatch (argv, argc, "-no-build-details",
 			      "--no-build-details", 7, NULL, &skip_args);
 
+#ifdef HAVE_JSON
+  init_json ();
+#endif
+
 #ifdef HAVE_MODULES
   bool module_assertions
     = argmatch (argv, argc, "-module-assertions", "--module-assertions", 15,
diff --git a/src/json.c b/src/json.c
index 79be55bd54..0f3b227a78 100644
--- a/src/json.c
+++ b/src/json.c
@@ -31,18 +31,17 @@ along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.  */
 static bool
 json_has_prefix (const char *string, const char *prefix)
 {
-  size_t string_len = strlen (string);
-  size_t prefix_len = strlen (prefix);
-  return string_len >= prefix_len && memcmp (string, prefix, prefix_len) == 0;
+  return strncmp (string, prefix, strlen (prefix)) == 0;
 }
 
 static bool
 json_has_suffix (const char *string, const char *suffix)
 {
-  size_t string_len = strlen (string);
-  size_t suffix_len = strlen (suffix);
-  return string_len >= suffix_len
-    && memcmp (string + string_len - suffix_len, suffix, suffix_len) == 0;
+  ptrdiff_t string_len = strlen (string);
+  ptrdiff_t suffix_len = strlen (suffix);
+  return (string_len >= suffix_len
+          && (memcmp (string + string_len - suffix_len, suffix, suffix_len)
+              == 0));
 }
 
 static Lisp_Object
@@ -54,9 +53,7 @@ json_make_string (const char *data, ptrdiff_t size)
 static Lisp_Object
 json_build_string (const char *data)
 {
-  size_t size = strlen (data);
-  eassert (size < PTRDIFF_MAX);
-  return json_make_string (data, size);
+  return json_make_string (data, strlen (data));
 }
 
 static Lisp_Object
@@ -68,7 +65,7 @@ json_encode (Lisp_Object string)
 static _Noreturn void
 json_out_of_memory (void)
 {
-  xsignal0 (Qjson_out_of_memory);
+  memory_full (SIZE_MAX);
 }
 
 static _Noreturn void
@@ -97,7 +94,7 @@ static void
 check_string_without_embedded_nulls (Lisp_Object object)
 {
   CHECK_STRING (object);
-  CHECK_TYPE (memchr (SDATA (object), '\0', SBYTES (object)) == NULL,
+  CHECK_TYPE (strlen (SSDATA (object)) == SBYTES (object),
               Qstring_without_embedded_nulls_p, object);
 }
 
@@ -114,15 +111,12 @@ static json_t *lisp_to_json (Lisp_Object) ATTRIBUTE_WARN_UNUSED_RESULT;
 /* This returns Lisp_Object so we can use unbind_to.  The return value
    is always nil.  */
 
-static _GL_ARG_NONNULL ((2)) Lisp_Object
+static Lisp_Object
 lisp_to_json_toplevel_1 (Lisp_Object lisp, json_t **json)
 {
   if (VECTORP (lisp))
     {
       ptrdiff_t size = ASIZE (lisp);
-      eassert (size >= 0);
-      if (size > SIZE_MAX)
-        xsignal1 (Qoverflow_error, build_string ("vector is too long"));
       *json = json_check (json_array ());
       ptrdiff_t count = SPECPDL_INDEX ();
       record_unwind_protect_ptr (json_release_object, json);
@@ -194,9 +188,6 @@ lisp_to_json (Lisp_Object lisp)
     {
       Lisp_Object encoded = json_encode (lisp);
       ptrdiff_t size = SBYTES (encoded);
-      eassert (size >= 0);
-      if (size > SIZE_MAX)
-        xsignal1 (Qoverflow_error, build_string ("string is too long"));
       return json_check (json_stringn (SSDATA (encoded), size));
     }
 
@@ -231,15 +222,13 @@ each object.  */)
 struct json_buffer_and_size
 {
   const char *buffer;
-  size_t size;
+  ptrdiff_t size;
 };
 
 static Lisp_Object
 json_insert (void *data)
 {
   const struct json_buffer_and_size *buffer_and_size = data;
-  if (buffer_and_size->size > PTRDIFF_MAX)
-    xsignal1 (Qoverflow_error, build_string ("buffer too large"));
   insert (buffer_and_size->buffer, buffer_and_size->size);
   return Qnil;
 }
@@ -289,7 +278,7 @@ OBJECT.  */)
   return unbind_to (count, Qnil);
 }
 
-static _GL_ARG_NONNULL ((1)) Lisp_Object
+static Lisp_Object
 json_to_lisp (json_t *json)
 {
   switch (json_typeof (json))
@@ -304,43 +293,33 @@ json_to_lisp (json_t *json)
       {
         json_int_t value = json_integer_value (json);
         if (FIXNUM_OVERFLOW_P (value))
-          xsignal1 (Qoverflow_error,
-                    build_string ("JSON integer is too large"));
+          xsignal0 (Qoverflow_error);
         return make_number (value);
       }
     case JSON_REAL:
       return make_float (json_real_value (json));
     case JSON_STRING:
-      {
-        size_t size = json_string_length (json);
-        if (FIXNUM_OVERFLOW_P (size))
-          xsignal1 (Qoverflow_error, build_string ("JSON string is too long"));
-        return json_make_string (json_string_value (json), size);
-      }
+      return json_make_string (json_string_value (json),
+                               json_string_length (json));
     case JSON_ARRAY:
       {
         if (++lisp_eval_depth > max_lisp_eval_depth)
           xsignal0 (Qjson_object_too_deep);
-        size_t size = json_array_size (json);
-        if (FIXNUM_OVERFLOW_P (size))
-          xsignal1 (Qoverflow_error, build_string ("JSON array is too long"));
-        Lisp_Object result = Fmake_vector (make_natnum (size), Qunbound);
+        ptrdiff_t size = json_array_size (json);
+        struct Lisp_Vector *v = allocate_vector (size);
         for (ptrdiff_t i = 0; i < size; ++i)
-          ASET (result, i,
-                json_to_lisp (json_array_get (json, i)));
+	  v->contents[i] = json_to_lisp (json_array_get (json, i));
         --lisp_eval_depth;
-        return result;
+        return make_lisp_ptr (v, Lisp_Vectorlike);
       }
     case JSON_OBJECT:
       {
         if (++lisp_eval_depth > max_lisp_eval_depth)
           xsignal0 (Qjson_object_too_deep);
-        size_t size = json_object_size (json);
-        if (FIXNUM_OVERFLOW_P (size))
-          xsignal1 (Qoverflow_error,
-                    build_string ("JSON object has too many elements"));
-        Lisp_Object result = CALLN (Fmake_hash_table, QCtest, Qequal,
-                                    QCsize, make_natnum (size));
+        ptrdiff_t size = json_object_size (json);
+        Lisp_Object result
+          = make_hash_table (hashtest_equal, size, DEFAULT_REHASH_SIZE,
+                             DEFAULT_REHASH_THRESHOLD, Qnil, false);
         struct Lisp_Hash_Table *h = XHASH_TABLE (result);
         const char *key_str;
         json_t *value;
@@ -399,23 +378,12 @@ json_read_buffer_callback (void *buffer, size_t buflen, void *data)
   /* First, parse from point to the gap or the end of the accessible
      portion, whatever is closer.  */
   ptrdiff_t point = d->point;
-  ptrdiff_t end;
-  {
-    bool overflow = INT_ADD_WRAPV (BUFFER_CEILING_OF (point), 1, &end);
-    eassert (!overflow);
-  }
-  size_t count;
-  {
-    bool overflow = INT_SUBTRACT_WRAPV (end, point, &count);
-    eassert (!overflow);
-  }
+  ptrdiff_t end = BUFFER_CEILING_OF (point) + 1;
+  ptrdiff_t count = end - point;
   if (buflen < count)
     count = buflen;
   memcpy (buffer, BYTE_POS_ADDR (point), count);
-  {
-    bool overflow = INT_ADD_WRAPV (d->point, count, &d->point);
-    eassert (!overflow);
-  }
+  d->point += count;
   return count;
 }
 
@@ -444,14 +412,11 @@ not moved.  */)
   /* Convert and then move point only if everything succeeded.  */
   Lisp_Object lisp = json_to_lisp (object);
 
-  {
-    /* Adjust point by how much we just read.  Do this here because
-       tokener->char_offset becomes incorrect below.  */
-    bool overflow = INT_ADD_WRAPV (point, error.position, &point);
-    eassert (!overflow);
-    eassert (point <= ZV_BYTE);
-    SET_PT_BOTH (BYTE_TO_CHAR (point), point);
-  }
+  /* Adjust point by how much we just read.  Do this here because
+     tokener->char_offset becomes incorrect below.  */
+  eassert (0 <= error.position && error.position <= ZV_BYTE - point);
+  point += error.position;
+  SET_PT_BOTH (BYTE_TO_CHAR (point), point);
 
   return unbind_to (count, lisp);
 }
@@ -462,8 +427,6 @@ not moved.  */)
 static void
 define_error (Lisp_Object name, const char *message, Lisp_Object parent)
 {
-  eassert (SYMBOLP (name));
-  eassert (SYMBOLP (parent));
   Lisp_Object parent_conditions = Fget (parent, Qerror_conditions);
   eassert (CONSP (parent_conditions));
   eassert (!NILP (Fmemq (parent, parent_conditions)));
@@ -473,6 +436,12 @@ define_error (Lisp_Object name, const char *message, Lisp_Object parent)
 }
 
 void
+init_json (void)
+{
+  json_set_alloc_funcs (xmalloc, xfree);
+}
+
+void
 syms_of_json (void)
 {
   DEFSYM (QCnull, ":null");
diff --git a/src/lisp.h b/src/lisp.h
index 43d8846619..8e530619b8 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -3442,6 +3442,7 @@ extern void syms_of_image (void);
 
 #ifdef HAVE_JSON
 /* Defined in json.c.  */
+extern void init_json (void);
 extern void syms_of_json (void);
 #endif
 
-- 
2.13.6