Diff

Differences From Artifact [f995e1562e]:

To Artifact [5e15b1175b]:


174
175
176
177
178
179
180










181
182
183
184
185
186
187
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
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 $cname\($adefs_c) \{"
		_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 rv;"
			_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
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 = 0;"
				_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;"
			}