Tcl Library Source Code

Check-in [2d0b61da55]
Login
Bounty program for improvements to Tcl and certain Tcl packages.

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:See ticket [6efa4f571af052]. Worked around issues with the critcl v2 application the Tcllib C code is geared towards. Bumped json version to 1.3.1, jsonc to 1.1.1, and tcllibc to 0.3.13.
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 2d0b61da555bdd0616e0b07daa7eca7506eb48d0
User & Date: andreask 2014-01-07 21:41:51
References
2014-01-08
00:18 Closed ticket [6efa4f571a]: C-implementation for json2dict plus 6 other changes artifact: 30e1f9d4a4 user: aku
Context
2014-01-07
23:00
Move many-* wrapper to before its usage. Bumped version to 1.3.2. v1.3.1 is broken. check-in: 09ed31fbfc user: andreask tags: trunk
21:41
See ticket [6efa4f571af052]. Worked around issues with the critcl v2 application the Tcllib C code is geared towards. Bumped json version to 1.3.1, jsonc to 1.1.1, and tcllibc to 0.3.13. check-in: 2d0b61da55 user: andreask tags: trunk
2014-01-06
23:44
See ticket [6efa4f571af052]. Reworked the Json/C code to use a bison-pased parser provided by Mikhail. No separate data structures to convert, just direct generation of Tcl structures. Changes compared to the original submission: - Use List, not Dict operations for objects, i.e. be Tcl 8.4 compatible. - Do not generate Int/Double objects, only strings. Conversion to actual int is lazy, when actually needed. Also ensures that compile-time Tcl version does not restrict range of integers, only runtime Tcl version. - Allow all values as toplevel json, not just array and object. - Currently no shared objects for the fixed values (null, true, false). Note that the RE-based json validation is still faster on even moderatly sized strings, even when just using a stripped C lexer not generating token values. Bumped jsonc to version 1.1 and tcllibc to version 0.3.12. check-in: 11390a7baa user: andreask tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to modules/json/ChangeLog.









1
2
3
4
5
6
7







2014-01-06  Andreas Kupries  <[email protected]>

	See ticket [6efa4f571af052].
	c: Removed json-parser files.
	c/json.y: New parser.
	c/json.tab.c: Generated parser code.
	c/json_y.h: Header to binding.
>
>
>
>
>
>
>
>







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
2014-01-07  Andreas Kupries  <[email protected]>

	* c/json.tab.c: Worked around issues with the critcl v2
	* c/json.y: application the Tcllib C code is geared towards.
	* json.tcl: Bumped json version to 1.3.1, jsonc to 1.1.1,
	* jsonc.tcl: and tcllibc to 0.3.13.
	* tcllibc.tcl: See ticket [6efa4f571af052].

2014-01-06  Andreas Kupries  <[email protected]>

	See ticket [6efa4f571af052].
	c: Removed json-parser files.
	c/json.y: New parser.
	c/json.tab.c: Generated parser code.
	c/json_y.h: Header to binding.

Changes to modules/json/c/json.tab.c.

1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
#endif
  return yyresult;
}


#line 144 "json.y"

#include <err.h>

void
jsonparse (struct context* context)
{
  yyparse (context);
}

#define DRAIN(n) context->text += n, context->remaining -= n






<
<







1370
1371
1372
1373
1374
1375
1376


1377
1378
1379
1380
1381
1382
1383
#endif
  return yyresult;
}


#line 144 "json.y"



void
jsonparse (struct context* context)
{
  yyparse (context);
}

#define DRAIN(n) context->text += n, context->remaining -= n

Changes to modules/json/c/json.y.

138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
	}
	| string
	| object
	| list
	;

%%
#include <err.h>

void
jsonparse (struct context* context)
{
  yyparse (context);
}

#define DRAIN(n) context->text += n, context->remaining -= n






<
<







138
139
140
141
142
143
144


145
146
147
148
149
150
151
	}
	| string
	| object
	| list
	;

%%


void
jsonparse (struct context* context)
{
  yyparse (context);
}

#define DRAIN(n) context->text += n, context->remaining -= n

Changes to modules/json/c/json_y.h.

42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
#if 0
extern int
jsonlex(struct context *);
#endif

extern void
jsonskip(struct context *);

/*
 * Default: Tracing off.
 */
#ifndef JSON_DEBUG
#define JSON_DEBUG 0
#endif

#if JSON_DEBUG
#define TRACE(x) do { printf x ; fflush (stdout); } while (0)
#else
#define TRACE(x)
#endif






|













42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
#if 0
extern int
jsonlex(struct context *);
#endif

extern void
jsonskip (struct context *);

/*
 * Default: Tracing off.
 */
#ifndef JSON_DEBUG
#define JSON_DEBUG 0
#endif

#if JSON_DEBUG
#define TRACE(x) do { printf x ; fflush (stdout); } while (0)
#else
#define TRACE(x)
#endif

Changes to modules/json/json.tcl.

27
28
29
30
31
32
33

34
35
36
37
38
39
40
41
...
168
169
170
171
172
173
174







175
176
177
178
179
180
181
...
261
262
263
264
265
266
267
268
    variable accel
    set r 0
    switch -exact -- $key {
	critcl {
	    # Critcl implementation of json requires Tcl 8.4.
	    if {![package vsatisfies [package provide Tcl] 8.4]} {return 0}
	    if {[catch {package require tcllibc}]} {return 0}

	    set r [llength [info commands ::json::json2dict_critcl]]
	}
	tcl {
	    variable selfdir
	    source [file join $selfdir json_tcl.tcl]
	    set r 1
	}
        default {
................................................................................
	if {[LoadAccelerator $e]} {
	    SwitchTo $e
	    break
	}
    }
    unset e
}








# ### ### ### ######### ######### #########
## Tcl implementation of validation, shared for Tcl and C implementation.
##
## The regexp based validation is consistently faster than json-c.
## Suspected reasons: Tcl REs are mainly in C as well, and json-c has
## overhead in constructing its own data structures. While irrelevant
................................................................................
proc ::json::string2json {str} {
    return "\"$str\""
}

# ### ### ### ######### ######### #########
## Ready

package provide json 1.3






>
|







 







>
>
>
>
>
>
>







 







|
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
...
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
...
269
270
271
272
273
274
275
276
    variable accel
    set r 0
    switch -exact -- $key {
	critcl {
	    # Critcl implementation of json requires Tcl 8.4.
	    if {![package vsatisfies [package provide Tcl] 8.4]} {return 0}
	    if {[catch {package require tcllibc}]} {return 0}
	    # Check for the jsonc 1.1.1 API we are fixing later.
	    set r [llength [info commands ::json::many_json2dict_critcl]]
	}
	tcl {
	    variable selfdir
	    source [file join $selfdir json_tcl.tcl]
	    set r 1
	}
        default {
................................................................................
	if {[LoadAccelerator $e]} {
	    SwitchTo $e
	    break
	}
    }
    unset e
}

# ### ### ### ######### ######### #########
## Wrapper fix for the jsonc package to match APIs.

proc ::json::many-json2dict_critcl {args} {
    eval [linsert $args 0 ::json::many_json2dict_critcl]
}

# ### ### ### ######### ######### #########
## Tcl implementation of validation, shared for Tcl and C implementation.
##
## The regexp based validation is consistently faster than json-c.
## Suspected reasons: Tcl REs are mainly in C as well, and json-c has
## overhead in constructing its own data structures. While irrelevant
................................................................................
proc ::json::string2json {str} {
    return "\"$str\""
}

# ### ### ### ######### ######### #########
## Ready

package provide json 1.3.1

Changes to modules/json/jsonc.tcl.

4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
..
37
38
39
40
41
42
43


44
45
46
47
48
49
50
51
52
53
54
55
56
57
#	Binding to a yacc/bison parser by Mikhail.
#
# Copyright (c) 2013 - critcl wrapper - Andreas Kupries <[email protected]>
# Copyright (c) 2013 - C binding      - [email protected]

package require critcl
# @sak notprovided jsonc
package provide jsonc 1.1
package require Tcl 8.4

#critcl::cheaders -g
#critcl::debug memory symbols
critcl::cheaders -Ic c/*.h
critcl::csources c/*.c

................................................................................
	context.I      = I;
	context.result = TCL_ERROR;

	jsonparse (&context);
	return context.result;
    }



    critcl::ccommand many-json2dict_critcl {dummy I objc objv} {
	struct context context = { NULL };

	int                      max;
	int                      found;

	Tcl_Obj* result = Tcl_NewListObj(0, NULL);

	if ((objc < 2) || (objc > 3)) {
	    Tcl_WrongNumArgs(I, 1, objv, "jsonText ?max?");
	    return TCL_ERROR;
	}

	if (objc == 3) {






|







 







>
>
|





|







4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
..
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
#	Binding to a yacc/bison parser by Mikhail.
#
# Copyright (c) 2013 - critcl wrapper - Andreas Kupries <[email protected]>
# Copyright (c) 2013 - C binding      - [email protected]

package require critcl
# @sak notprovided jsonc
package provide jsonc 1.1.1
package require Tcl 8.4

#critcl::cheaders -g
#critcl::debug memory symbols
critcl::cheaders -Ic c/*.h
critcl::csources c/*.c

................................................................................
	context.I      = I;
	context.result = TCL_ERROR;

	jsonparse (&context);
	return context.result;
    }

    # Issue with critcl 2 used here. Cannot use '-', incomplete distinction of C and Tcl names.
    # The json.tcl file making use of this code has a wrapper fixing the issue.
    critcl::ccommand many_json2dict_critcl {dummy I objc objv} {
	struct context context = { NULL };

	int                      max;
	int                      found;

	Tcl_Obj* result = Tcl_NewListObj (0, NULL);

	if ((objc < 2) || (objc > 3)) {
	    Tcl_WrongNumArgs(I, 1, objv, "jsonText ?max?");
	    return TCL_ERROR;
	}

	if (objc == 3) {

Changes to modules/json/pkgIndex.tcl.

1
2
3
4
5
6
7
# Tcl package index file, version 1.1

if {![package vsatisfies [package provide Tcl] 8.4]} {return}
package ifneeded json 1.3 [list source [file join $dir json.tcl]]

if {![package vsatisfies [package provide Tcl] 8.5]} {return}
package ifneeded json::write 1.0.2 [list source [file join $dir json_write.tcl]]


|



1
2
3
4
5
6
7
# Tcl package index file, version 1.1

if {![package vsatisfies [package provide Tcl] 8.4]} {return}
package ifneeded json 1.3.1 [list source [file join $dir json.tcl]]

if {![package vsatisfies [package provide Tcl] 8.5]} {return}
package ifneeded json::write 1.0.2 [list source [file join $dir json_write.tcl]]

Changes to modules/tcllibc.tcl.

1
2
3
4
5
6
7
8
9
10
11
12
# Umbrella, i.e. Bundle, to put all of the critcl modules which are
# found in Tcllib in one shared library.

package require critcl
package provide tcllibc 0.3.12

namespace eval ::tcllib {
    variable tcllibc_rcsid {$Id: tcllibc.tcl,v 1.13 2010/05/25 19:26:17 andreas_kupries Exp $}
    critcl::ccode {
        /* no code required in this file */
    }
}



|







1
2
3
4
5
6
7
8
9
10
11
12
# Umbrella, i.e. Bundle, to put all of the critcl modules which are
# found in Tcllib in one shared library.

package require critcl
package provide tcllibc 0.3.13

namespace eval ::tcllib {
    variable tcllibc_rcsid {$Id: tcllibc.tcl,v 1.13 2010/05/25 19:26:17 andreas_kupries Exp $}
    critcl::ccode {
        /* no code required in this file */
    }
}