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