Diff

Differences From Artifact [f995e1562e]:

To Artifact [5e15b1175b]:


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