174
175
176
177
178
179
180
181
182
183
184
185
186
187
|
}
if {[llength $adefs_c] == 0} {
set adefs_c "void"
} else {
set adefs_c [join $adefs_c {, }]
}
# Determine how to return in failure
if {$rtype != "void"} {
if {[info exists returnErrorValue]} {
set return_failure "return(${returnErrorValue})"
} else {
switch -- $rtype {
|
>
>
>
>
>
>
>
>
>
>
|
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
|
}
if {[llength $adefs_c] == 0} {
set adefs_c "void"
} else {
set adefs_c [join $adefs_c {, }]
}
# Determine actual C return type:
switch -- $rtype {
"ok" {
set rtype_c "int"
}
default {
set rtype_c $rtype
}
}
# Determine how to return in failure
if {$rtype != "void"} {
if {[info exists returnErrorValue]} {
set return_failure "return(${returnErrorValue})"
} else {
switch -- $rtype {
|
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
|
}
}
} else {
set return_failure "return"
}
# Define the C function
_ccode $handle "$rtype $cname\($adefs_c) \{"
## Define the Tcl return value checking variable
_ccode $handle " int tclrv;"
## If the interpreters return value is relevant, create a variable to store it
if {$rtype != "ok" && $rtype != "void"} {
_ccode $handle " Tcl_Obj *rv_interp;"
}
## If we are returning a value, declare a variable for that
if {$rtype != "void"} {
_ccode $handle " $rtype rv;"
}
## If we need to create a new interpreter, do so
if {$newInterp} {
set interp_name "ip"
_ccode $handle " Tcl_Interp *${interp_name};"
}
|
|
|
|
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
|
}
}
} else {
set return_failure "return"
}
# Define the C function
_ccode $handle "$rtype_c $cname\($adefs_c) \{"
## Define the Tcl return value checking variable
_ccode $handle " int tclrv;"
## If the interpreters return value is relevant, create a variable to store it
if {$rtype != "ok" && $rtype != "void"} {
_ccode $handle " Tcl_Obj *rv_interp;"
}
## If we are returning a value, declare a variable for that
if {$rtype != "void"} {
_ccode $handle " $rtype_c rv;"
}
## If we need to create a new interpreter, do so
if {$newInterp} {
set interp_name "ip"
_ccode $handle " Tcl_Interp *${interp_name};"
}
|
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
|
if {$rtype != "ok" && $rtype != "void"} {
_ccode $handle " rv_interp = Tcl_GetObjResult(${interp_name});"
}
switch -- $rtype {
void { }
ok {
_ccode $handle " rv = 0;"
}
int {
_ccode $handle " if (Tcl_GetIntFromObj(ip, rv_interp, &rv) != TCL_OK) $return_failure;"
}
long {
_ccode $handle " if (Tcl_GetLongFromObj(ip, rv_interp, &rv) != TCL_OK) $return_failure;"
}
|
|
|
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
|
if {$rtype != "ok" && $rtype != "void"} {
_ccode $handle " rv_interp = Tcl_GetObjResult(${interp_name});"
}
switch -- $rtype {
void { }
ok {
_ccode $handle " rv = TCL_OK;"
}
int {
_ccode $handle " if (Tcl_GetIntFromObj(ip, rv_interp, &rv) != TCL_OK) $return_failure;"
}
long {
_ccode $handle " if (Tcl_GetLongFromObj(ip, rv_interp, &rv) != TCL_OK) $return_failure;"
}
|