158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
|
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
|
+
+
|
set interp_name $var
break
}
}
# Create the C-style argument definition
## Create a list of all arguments
foreach {type var} $adefs {
# Update definition of types
lappend adefs_c [list $type $var]
# Note the type for this variable
set types($var) $type
# The Tcl interpreter is not added to the list of Tcl arguments
if {$type == "Tcl_Interp*"} {
continue
}
# Update the list of arguments to pass to Tcl
lappend args $var
}
## Convert that list into something we can use in a C prototype
if {[llength $adefs_c] == 0} {
set adefs_c "void"
} else {
set adefs_c [join $adefs_c {, }]
}
# Determine actual C return type:
|
290
291
292
293
294
295
296
297
298
299
300
301
302
303
|
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
|
+
|
_ccode $handle " _$arg = $arg;"
}
default {
return -code error "Unknown type: $type"
}
}
# If we don't have a procedure to call, set the variables locally
if {$procname == ""} {
_ccode $handle " if (!Tcl_ObjSetVar2(${interp_name}, Tcl_NewStringObj(\"${arg}\", -1), NULL, _$arg, 0)) $return_failure;"
}
}
_ccode $handle ""
# Evaluate script
|