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
37
|
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
37
|
-
+
-
+
|
}
if {[info command ::tcc4tcl] == ""} {
load [file join $dir tcc4tcl[info sharedlibextension]] tcc4tcl
}
set count 0
proc new {{output ""}} {
proc new {{output ""} {pkgName ""}} {
variable dir
variable count
set handle ::tcc4tcl::tcc_[incr count]
set tcc_handle ::tcc4tcl::tcc_[incr count]
if {$output == ""} {
set type "memory"
} else {
set type "dll"
}
array set $handle [list tcc $tcc_handle code "" type $type]
array set $handle [list tcc $tcc_handle code "" type $type filename $output package $pkgName]
proc $handle {cmd args} [string map [list @@HANDLE@@ $handle] {
set handle {@@HANDLE@@}
uplevel 1 [list ::tcc4tcl::_$cmd $handle {*}$args]
}]
return $handle
|
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
|
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
106
107
108
109
110
111
112
113
114
115
116
117
118
|
+
+
+
-
+
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
|
if {[info exists state(tk)]} {
set state(code) "#include <tk.h>\n$state(code)"
}
set state(code) "#include <tcl.h>\n\n$state(code)"
tcc4tcl $dir $state(type) tcc
switch -- $state(type) {
"memory" {
tcc compile $state(code)
tcc compile $state(code)
foreach {procname cname} $state(procs) {
tcc command $procname $cname
foreach {procname cname} $state(procs) {
tcc command $procname $cname
}
}
"dll" {
append state(code) "int [string totitle $state(package)]_Init(Tcl_Interp *interp) \{\n"
append state(code) "#ifdef USE_TCL_STUBS\n"
append state(code) " if (Tcl_InitStubs(interp, \"8.4\" , 0) == 0L) \{\n"
append state(code) " return TCL_ERROR;\n"
append state(code) " \}\n"
append state(code) "#endif\n"
foreach {procname cname} $state(procs) {
append state(code) " Tcl_CreateObjCommand(interp, \"$procname\", $cname, NULL, NULL);"
}
append state(code) "Tcl_PkgProvide(interp, \"$state(package)\", \"0.0\");\n"
append state(code) " return(TCL_OK);\n"
append state(code) "\}"
tcc compile $state(code)
tcc output_file $state(filename)
}
}
rename $handle ""
unset $handle
}
|