Overview
| Comment: | Added "cwrap" subcommand to handle wrapping and creating prototype |
|---|---|
| Timelines: | family | ancestors | descendants | both | trunk |
| Files: | files | file ages | folders |
| SHA1: |
2bc3ec252af7be0ec707601e7c47d864 |
| 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 |
proc ::tcc4tcl::cproc {name adefs rtype {body "#"}} {
set handle [::tcc4tcl::new]
$handle cproc $name $adefs $rtype $body
return [$handle go]
}
| | | 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 |
}
default {
set rtype2 $rtype
}
}
# Create wrapped function
| < | | | | | > > > > > > | 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 |
## 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]
| < | | 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]
}
|
| ︙ | ︙ |