10
11
12
13
14
15
16
17
18
19
20
21
22
23
|
catch { load {} tcc4tcl }
}
if {[info command ::tcc4tcl] == ""} {
load [file join $dir tcc4tcl[info sharedlibextension]] tcc4tcl
}
set count 0
proc new {{output ""} {pkgName ""}} {
variable dir
variable count
set handle ::tcc4tcl::tcc_[incr count]
|
>
>
>
>
>
>
>
>
>
>
>
>
>
|
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
|
catch { load {} tcc4tcl }
}
if {[info command ::tcc4tcl] == ""} {
load [file join $dir tcc4tcl[info sharedlibextension]] tcc4tcl
}
set count 0
proc lookupNamespace {name} {
if {![string match "::*" $name]} {
set nsfrom [uplevel 2 {namespace current}]
if {$nsfrom eq "::"} {
set nsfrom ""
}
set name "${nsfrom}::${name}"
}
return $name
}
proc new {{output ""} {pkgName ""}} {
variable dir
variable count
set handle ::tcc4tcl::tcc_[incr count]
|
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
|
set cmd "go"
set args [list 1 {*}$args]
}
set callcmd ::tcc4tcl::_$cmd
if {[info command $callcmd] == ""} {
return -code error "unknown or ambiguous subcommand \"$cmd\": must be cwrap, ccode, cproc, delete, linktclcommand, code, tk, add_include_path, add_library_path, add_library, or go"
}
uplevel 1 [list $callcmd $handle {*}$args]
}]
return $handle
}
proc _linktclcommand {handle cSymbol args} {
upvar #0 $handle state
set argc [llength $args]
if {$argc != 1 && $argc != 2} {
return -code error "_linktclcommand handle cSymbol tclCommand ?clientData?"
}
lappend state(procs) $cSymbol $args
}
proc _add_include_path {handle args} {
upvar #0 $handle state
lappend state(add_inc_path) {*}$args
}
|
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
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
|
set cmd "go"
set args [list 1 {*}$args]
}
set callcmd ::tcc4tcl::_$cmd
if {[info command $callcmd] == ""} {
return -code error "unknown or ambiguous subcommand \"$cmd\": must be cwrap, ccode, cproc, ccommand, delete, linktclcommand, code, tk, add_include_path, add_library_path, add_library, or go"
}
uplevel 1 [list $callcmd $handle {*}$args]
}]
return $handle
}
proc _linktclcommand {handle cSymbol args} {
upvar #0 $handle state
set argc [llength $args]
if {$argc != 1 && $argc != 2} {
return -code error "_linktclcommand handle cSymbol tclCommand ?clientData?"
}
lappend state(procs) $cSymbol $args
}
proc _ccommand {handle tclCommand argList body} {
upvar #0 $handle state
set tclCommand [lookupNamespace $tclCommand]
set cSymbol [cleanname [namespace tail $tclCommand]]
lappend state(procs) $tclCommand [list $cSymbol]
foreach {clientData interp objc objv} $argList {}
set cArgList "ClientData $clientData, Tcl_Interp *$interp, int $objc, Tcl_Obj *CONST $objv\[\]"
append state(code) "int $cSymbol\($cArgList) {\n$body\n}\n"
return
}
proc _add_include_path {handle args} {
upvar #0 $handle state
lappend state(add_inc_path) {*}$args
}
|
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
|
if {$cname == ""} {
set cname c_[tcc4tcl::cleanname $name]
}
set wname tcl_[tcc4tcl::cleanname $name]
# Fully qualified proc name
if {![string match "::*" $name]} {
set nsfrom [uplevel 1 {namespace current}]
if {$nsfrom eq "::"} {
set nsfrom ""
}
set name "${nsfrom}::${name}"
}
|
<
<
<
<
<
|
<
<
|
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
|
if {$cname == ""} {
set cname c_[tcc4tcl::cleanname $name]
}
set wname tcl_[tcc4tcl::cleanname $name]
# Fully qualified proc name
set name [lookupNamespace $name]
array set types {}
set varnames {}
set cargs {}
set cnames {}
set cbody {}
set code {}
|