Diff

Differences From Artifact [47dd5cbf47]:

To Artifact [7f2fbfc8a7]:


352
353
354
355
356
357
358
359

360
361
362
363
364

365
366
367
368
369
370
371
352
353
354
355
356
357
358

359
360
361
362
363

364
365
366
367
368
369
370
371







-
+




-
+







	append code $body
	append code "\nreturn TCL_OK;\n\}"

	return $code
}

#---------------------------------------------------------------------
proc ::tcc4tcl::cproc {name adefs rtype {body "#"} {addfuncs ""}} {
proc ::tcc4tcl::cproc {name adefs rtype {body "#"}} {
	foreach {code cbody} [wrap $name $adefs $rtype $body] break

	::tcc4tcl::ccode $code

	uplevel 1 [list ::tcc4tcl::ccommand $name {dummy ip objc objv} $cbody $addfuncs]
	uplevel 1 [list ::tcc4tcl::ccommand $name {dummy ip objc objv} $cbody]
}

#---------------------------------------------------------------------
proc ::tcc4tcl::cdata {name data} {
	# Extract bytes from data
	binary scan $data c* bytes

405
406
407
408
409
410
411
412

413
414
415
416
417
418
419
405
406
407
408
409
410
411

412
413
414
415
416
417
418
419







-
+








	uplevel 1 [list tcc4tcl::ccommand $name {dummy ip objc objv} $cbody]

	return $name
}

#-------------------------------------------------------------------
proc ::tcc4tcl::ccommand {procname anames body {addfuncs ""}} {
proc ::tcc4tcl::ccommand {procname anames body} {
	variable tcc

	# Fully qualified proc name
	if {[string match "::*" $procname]} {
		# procname is already absolute
	} else {
		set nsfrom [uplevel 1 {namespace current}]    
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
461
462
463
464
465
466
467








468
469
470
471
472
473
474







-
-
-
-
-
-
-
-







	set tcc(code) ""

	append code "int $cname (ClientData $v(clientdata),Tcl_Interp *$v(interp),"
	append code "int $v(objc),Tcl_Obj *CONST $v(objv)\[\]) {" "\n"
	append code $body "\n"
	append code "}" "\n"

	if {[llength $addfuncs] > 0} {
		set tcc(cc) [tcc4tcl::new]

		foreach addfunc $addfuncs {
			$tcc(cc) add_runtime_sym $addfunc
		}
	}

	if {[catch {
		uplevel 1 [list tcc4tcl::cc $code]
	} err]} {
		unset tcc(cc)
		tcc4tcl::reset

		return -code error $err