Attachment 150445 Details for Bug 195863 – Patch json-module to use less memory and work faster (submitted upstream)

[patch] Patch json-module to use less memory and work faster (submitted upstream)

patch-json (text/plain), 6.54 KB, created by Mikhail T. on 2014-12-11 00:00:26 UTC

(hide)

Description:

Filename:

MIME Type:

Creator: Mikhail T.

Created: 2014-12-11 00:00:26 UTC

Size: 6.54 KB

patch

obsolete

>--- modules/json/c/json.y
>+++ modules/json/c/json.y
>@@ -3,26 +3,32 @@
>  * Mikhail.
>  */
> 
> %{
> #include <tcl.h>
>+#include <errno.h>
> #include <ctype.h>
> #include <math.h>
> #include <string.h>
> #include <stdlib.h>
> #include <assert.h>
>+#if TCL_MAJOR_VERSION > 8 || TCL_MINOR_VERSION > 4
>+#define USE_DICT
>+#endif
> 
> #include <json_y.h>
> 
> #define TOKEN(tok)   TRACE (("TOKEN  %s\n", tok))
> #define TOKEN1(tok)  TRACE (("TOKEN  %s (%s)\n", tok, Tcl_GetString(context->obj)))
> #define REDUCE(rule) TRACE (("REDUCE %s\n", rule))
> 
>-#define TRUE_O  (Tcl_NewStringObj("true", 4))
>-#define FALSE_O (Tcl_NewStringObj("false", 5))
>-#define NULL_O  (Tcl_NewStringObj("null", 4))
>+#define TRUE_O  staticobj(TRUEO)
>+#define FALSE_O staticobj(FALSEO)
>+#define NULL_O  staticobj(NULLO)
> 
>+enum constants { FALSEO, TRUEO, NULLO, NUMCONSTANTS };
>+static Tcl_Obj * staticobj(enum constants);
> static void jsonerror(struct context *, const char *);
> static int  jsonlexp(struct context *context);
> 
> #define YYPARSE_PARAM_TYPE void *
> #define YYPARSE_PARAM	   context
>@@ -105,18 +111,27 @@
> 	}
> 	;
> 
> members	: member
> 	{
>+#ifdef USE_DICT
>+		$$ = Tcl_NewDictObj();
>+		Tcl_DictObjPut(NULL, $$, $1.key, $1.val);
>+#else
> 	        $$ = Tcl_NewListObj(0, NULL);
> 		Tcl_ListObjAppendElement(NULL, $$, $1.key);
> 		Tcl_ListObjAppendElement(NULL, $$, $1.val);
>+#endif
> 	}
> 	| members ',' member
> 	{
>+#ifdef USE_DICT
>+		Tcl_DictObjPut(NULL, $1, $3.key, $3.val);
>+#else
> 		Tcl_ListObjAppendElement(NULL, $1, $3.key);
> 		Tcl_ListObjAppendElement(NULL, $1, $3.val);
>+#endif
> 		$$ = $1;
> 	}
> 	;
> 
> member	: string ':' value
>@@ -177,10 +192,69 @@
>       continue;
>     }
>     break;
>   }
> }
>+
>+/*
>+ * JSON has 3 string-literals: "null", "true", and "false". Instead of
>+ * creating a NEW Tcl-object EACH TIME such literal is encountered, we
>+ * return the reference to the first such object created (and bump its
>+ * reference-count to prevent memory errors).
>+ */
>+Tcl_Obj *
>+staticobj(enum constants constant)
>+{
>+    static Tcl_Obj   *objects[NUMCONSTANTS];
>+    Tcl_Obj         **p;
>+
>+    assert(constant >= 0 && constant < NUMCONSTANTS);
>+    p = objects + constant;
>+    if (*p == NULL) {
>+	/*
>+	 * This is the first time we were asked for an object for
>+	 * this constant. Create it to the best of our ability.
>+	 *
>+	 * Using the trick below, rather than the usual
>+	 * Tcl_NewStringObj(), avoids creation of a COPY
>+	 * of the string "null". Such copying is a waste,
>+	 * if the object itself is never to be freed...
>+	 */
>+	*p = Tcl_NewObj();
>+	switch (constant) {
>+	case NULLO:
>+	    (*p)->bytes = (void *)"null";
>+	    (*p)->length = 4;
>+	    break;
>+	case TRUEO:
>+	    /*
>+	     * A boolean-object's default string representation is
>+	     * "0" or "1", but we'd like the fancier "false" and
>+	     * "true" for our objects to better match the
>+	     * expectations of JSON-users.
>+	     */
>+	    Tcl_SetBooleanObj(*p, 1);
>+	    (*p)->bytes = (void *)"true";
>+	    (*p)->length = 4;
>+	    break;
>+	case FALSEO:
>+	    Tcl_SetBooleanObj(*p, 0);
>+	    (*p)->bytes = (void *)"false";
>+	    (*p)->length = 5;
>+	    break;
>+	default:
>+	    Tcl_Panic("Internal error in %s:%d unknown constant %d",
>+		__FILE__, __LINE__, (int)constant);
>+	}
>+    }
>+    /*
>+     * Increase the ref-count so nothing ever attempts to free
>+     * neither the static object we are returning, nor its bytes.
>+     */
>+    Tcl_IncrRefCount(*p);
>+    return *p;
>+}
> 
> static int
> jsonlexp(struct context *context)
> {
>   const char *bp = NULL;
>@@ -191,10 +265,17 @@
>   enum {
>     PLAIN	= 0x0000ff00,
>     INSTR	= 0x00ff0000
>   } lstate;
>   double 	 d;
>+  int		 i;
>+  long	 	 l;
>+  long long	 ll;
>+  Tcl_WideInt	 wi;
>+#ifdef USE_BIG_NUM
>+  mp_int	 mpi;
>+#endif
>   char		*end;
>   const char	*p;
>   int		 initialized = 0;
> 
>   /*
>@@ -343,32 +424,63 @@
>       yyerror("Escape character outside of string");
>       TOKEN ("escape error");
>       return -1;
>     }
> 
>+    context->obj = NULL;
>     /*
>      * We already considered the null, true, and false
>      * above, so it can only be a number now.
>-     *
>-     * NOTE: At this point we do not care about double
>-     * versus integer, nor about the possible integer
>-     * range. We generate a plain string Tcl_Obj and leave
>-     * it to the user of the generated structure to
>-     * convert to a number when actually needed. This
>-     * defered conversion also ensures that the Tcl and
>-     * platform we are building against does not matter
>-     * regarding integer range, only the abilities of the
>-     * Tcl at runtime.
>      */
>-
>+    errno = 0;
>     d = strtod(context->text, &end);
>-    if (end == context->text)
>-      goto bareword; /* Nothing parsed */
>-
>-    context->obj = Tcl_NewStringObj (context->text,
>-				     end - context->text);
>-
>+    if (end == context->text || isnan(d) || isinf(d))
>+	goto bareword; /* Nothing parsed */
>+    if (context->text[0] == '0' && context->text[1] != '.') {
>+	yyerror("Leading zeros aren't allowed in JSON");
>+	TOKEN("Leading zero error");
>+	return -1;
>+    }
>+    if (errno == ERANGE) {
>+	/* Too large. Let TCL core deal with it */
>+	goto donewithnumber;
>+    }
>+    /* See, if there was anything other than digit there: */
>+    for (p = context->text; p != end; p++) {
>+	if ((*p >= '0' && *p <= '9') || *p == '+' || *p == '-')
>+	    continue;
>+	context->obj = Tcl_NewDoubleObj(d);
>+	goto donewithnumber;
>+    }
>+    /* Didn't find any non-digits, must be an integer: */
>+    errno = 0;
>+    ll = strtoll(context->text, &end, 10);
>+    if (errno == ERANGE) {
>+	/* Too large. Let TCL core deal with it */
>+	goto donewithnumber;
>+    }
>+    /* Find the right integer-type for this number */
>+    i = ll;	/* int ? */
>+    if (i == ll) {
>+	context->obj = Tcl_NewIntObj(i);
>+	goto donewithnumber;
>+    }
>+    l = ll;	/* long ? */
>+    if (l == ll) {
>+	context->obj = Tcl_NewLongObj(l);
>+	goto donewithnumber;
>+    }
>+    wi = ll;	/* Tcl_WideInt */
>+    if (wi == ll) {
>+	context->obj = Tcl_NewWideIntObj(wi);
>+	goto donewithnumber;
>+    }
>+  donewithnumber:
>+    if (context->obj == NULL) {
>+	context->obj = Tcl_NewStringObj(context->text,
>+					end - context->text);
>+    }
>     context->remaining -= (end - context->text);
>     context->text = end;
>     TOKEN1 ("CONSTANT");
>     return CONSTANT;
>   }
>
>--- modules/json/tests/numbers.json
>+++ modules/json/tests/numbers.json
>@@ -0,0 +1,6 @@
>+{"numbers": {
>+	"int"	:	123,
>+	"long"	:	1234567890123456789,
>+	"bigint":	12345678901234567890123456789012345678901234567890123456789
>+}
>+}
>
>--- modules/json/tests/numbers.result
>+++ modules/json/tests/numbers.result
>@@ -0,0 +1,1 @@
>+numbers {int 123 long 1234567890123456789 bigint 12345678901234567890123456789012345678901234567890123456789}

Actions: View | Diff

Attachments on bug 195863: 150443 | 150444 | 150445 | 150446 | 150447