Check-in [2bc3ec252a]
Overview
Comment:Added "cwrap" subcommand to handle wrapping and creating prototype
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 2bc3ec252af7be0ec707601e7c47d864ceae3ad2
User & Date: rkeene on 2014-06-23 02:56:39
Other Links: manifest | tags
Context
2014-06-23
19:32
Updated to work harder to load shared objects (that are not ELF) check-in: c32ff7df22 user: rkeene tags: trunk
02:56
Added "cwrap" subcommand to handle wrapping and creating prototype check-in: 2bc3ec252a user: rkeene tags: trunk
02:49
Updated to not perform some tests on Darwin check-in: 6d4569b9da user: rkeene tags: trunk
Changes

Modified tcc4tcl.tcl from [1d2b6c2d4b] to [72f0a051fa].

77
78
79
80
81
82
83















84
85
86
87
88
89
90
	}

	proc _add_library {handle args} {
		upvar #0 $handle state

		lappend state(add_lib) {*}$args
	}
















	proc _cproc {handle name adefs rtype {body "#"}} {
		upvar #0 $handle state

		set wrap [uplevel 1 [list ::tcc4tcl::wrap $name $adefs $rtype $body]]

		set wrapped [lindex $wrap 0]







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
	}

	proc _add_library {handle args} {
		upvar #0 $handle state

		lappend state(add_lib) {*}$args
	}

	proc _cwrap {handle name adefs rtype} {
		upvar #0 $handle state

		set wrap [uplevel 1 [list ::tcc4tcl::wrap $name $adefs $rtype "#" "" 1]]

		set wrapped [lindex $wrap 0]
		set wrapper [lindex $wrap 1]
		set tclname [lindex $wrap 2]

		append state(code) $wrapped "\n"
		append state(code) $wrapper "\n"

		lappend state(procs) $name $tclname
	}

	proc _cproc {handle name adefs rtype {body "#"}} {
		upvar #0 $handle state

		set wrap [uplevel 1 [list ::tcc4tcl::wrap $name $adefs $rtype $body]]

		set wrapped [lindex $wrap 0]
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283

proc ::tcc4tcl::cproc {name adefs rtype {body "#"}} {
	set handle [::tcc4tcl::new]
	$handle cproc $name $adefs $rtype $body
	return [$handle go]
}

proc ::tcc4tcl::wrap {name adefs rtype {body "#"} {cname ""}} {
	if {$cname == ""} {
		set cname c_[tcc4tcl::cleanname $name]
	}

	set wname tcl_[tcc4tcl::cleanname $name]

	# Fully qualified proc name







|







284
285
286
287
288
289
290
291
292
293
294
295
296
297
298

proc ::tcc4tcl::cproc {name adefs rtype {body "#"}} {
	set handle [::tcc4tcl::new]
	$handle cproc $name $adefs $rtype $body
	return [$handle go]
}

proc ::tcc4tcl::wrap {name adefs rtype {body "#"} {cname ""} {includePrototype 0}} {
	if {$cname == ""} {
		set cname c_[tcc4tcl::cleanname $name]
	}

	set wname tcl_[tcc4tcl::cleanname $name]

	# Fully qualified proc name
324
325
326
327
328
329
330
331
332
333
334
335
336


337
338
339
340
341




342
343
344
345
346
347
348
		}
		default {
			set rtype2 $rtype
		}
	}

	# Create wrapped function
	if {$body ne "#"} {
		if {[llength $cargs] != 0} {
			set cargs_str [join $cargs {, }]
		} else {
			set cargs_str "void"
		}


		append code "static $rtype2 ${cname}($cargs_str) \{\n"
		append code $body
		append code "\}\n"
	} else {
		set cname [namespace tail $name]




	}

	# Create wrapper function
	## Supported input types
	##   Tcl_Interp*
	##   int
	##   long







<
|
|
|
|
|
>
>





>
>
>
>







339
340
341
342
343
344
345

346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
		}
		default {
			set rtype2 $rtype
		}
	}

	# Create wrapped function

	if {[llength $cargs] != 0} {
		set cargs_str [join $cargs {, }]
	} else {
		set cargs_str "void"
	}

	if {$body ne "#"} {
		append code "static $rtype2 ${cname}($cargs_str) \{\n"
		append code $body
		append code "\}\n"
	} else {
		set cname [namespace tail $name]

		if {$includePrototype} {
			append code "$rtype2 ${cname}($cargs_str);\n"
		}
	}

	# Create wrapper function
	## Supported input types
	##   Tcl_Interp*
	##   int
	##   long

Modified test.tcl from [6030390766] to [48b0848394].

77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
## Delete without performing
set handle [tcc4tcl::new]
$handle delete

# External functions (requires .so or .a (ELF) files which do not exist on Darwin)
if {[info exists ::env(TCC4TCL_TEST_RUN_NATIVE)] && $::tcl_platform(os) != "Darwin"} {
	set handle [tcc4tcl::new]
	$handle ccode {const char *curl_version(void);}
	$handle cproc curl_version {} vstring
	$handle add_library_path /usr/lib64
	$handle add_library_path /usr/lib
	$handle add_library curl
	$handle go
	puts [curl_version]
}








<
|







77
78
79
80
81
82
83

84
85
86
87
88
89
90
91
## Delete without performing
set handle [tcc4tcl::new]
$handle delete

# External functions (requires .so or .a (ELF) files which do not exist on Darwin)
if {[info exists ::env(TCC4TCL_TEST_RUN_NATIVE)] && $::tcl_platform(os) != "Darwin"} {
	set handle [tcc4tcl::new]

	$handle cwrap curl_version {} vstring
	$handle add_library_path /usr/lib64
	$handle add_library_path /usr/lib
	$handle add_library curl
	$handle go
	puts [curl_version]
}