tcc4tcl
Check-in [2bc3ec252a]
Login
HomeTimelineFilesBranchesTagsTicketsWiki
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
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

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

︙
77
78
79
80
81
82
83















84
85
86
87
88
89
90

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

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 ""}} {
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

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 {$body ne "#"} {
		if {[llength $cargs] != 0} {
			set cargs_str [join $cargs {, }]
		} else {
			set cargs_str "void"
		}
	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

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 ccode {const char *curl_version(void);}
	$handle cproc curl_version {} vstring
	$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]
}
︙

Powered by Fossil · RSS