Diff

Differences From Artifact [1d2b6c2d4b]:

To Artifact [72f0a051fa]:


77
78
79
80
81
82
83















84
85
86
87
88
89
90
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







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







	}

	proc _add_library {handle args} {
		upvar #0 $handle state

		lappend state(add_lib) {*}$args
	}

	proc _cwrap {handle name adefs rtype} {
		upvar #0 $handle state

		set wrap [uplevel 1 [list ::tcc4tcl::wrap $name $adefs $rtype "#" "" 1]]

		set wrapped [lindex $wrap 0]
		set wrapper [lindex $wrap 1]
		set tclname [lindex $wrap 2]

		append state(code) $wrapped "\n"
		append state(code) $wrapper "\n"

		lappend state(procs) $name $tclname
	}

	proc _cproc {handle name adefs rtype {body "#"}} {
		upvar #0 $handle state

		set wrap [uplevel 1 [list ::tcc4tcl::wrap $name $adefs $rtype $body]]

		set wrapped [lindex $wrap 0]
269
270
271
272
273
274
275
276

277
278
279
280
281
282
283
284
285
286
287
288
289
290

291
292
293
294
295
296
297
298







-
+








proc ::tcc4tcl::cproc {name adefs rtype {body "#"}} {
	set handle [::tcc4tcl::new]
	$handle cproc $name $adefs $rtype $body
	return [$handle go]
}

proc ::tcc4tcl::wrap {name adefs rtype {body "#"} {cname ""}} {
proc ::tcc4tcl::wrap {name adefs rtype {body "#"} {cname ""} {includePrototype 0}} {
	if {$cname == ""} {
		set cname c_[tcc4tcl::cleanname $name]
	}

	set wname tcl_[tcc4tcl::cleanname $name]

	# Fully qualified proc name
324
325
326
327
328
329
330
331
332
333
334
335
336







337
338
339
340
341




342
343
344
345
346
347
348
339
340
341
342
343
344
345






346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368







-
-
-
-
-
-
+
+
+
+
+
+
+





+
+
+
+







		}
		default {
			set rtype2 $rtype
		}
	}

	# Create wrapped function
	if {$body ne "#"} {
		if {[llength $cargs] != 0} {
			set cargs_str [join $cargs {, }]
		} else {
			set cargs_str "void"
		}
	if {[llength $cargs] != 0} {
		set cargs_str [join $cargs {, }]
	} else {
		set cargs_str "void"
	}

	if {$body ne "#"} {
		append code "static $rtype2 ${cname}($cargs_str) \{\n"
		append code $body
		append code "\}\n"
	} else {
		set cname [namespace tail $name]

		if {$includePrototype} {
			append code "$rtype2 ${cname}($cargs_str);\n"
		}
	}

	# Create wrapper function
	## Supported input types
	##   Tcl_Interp*
	##   int
	##   long