# tcc.tcl - library routines for the tcc wrapper (Mark Janssen)

namespace eval tcc4tcl {
   variable dir 
   variable libs
   variable includes
   variable count
   variable command_count
   variable commands
	variable dir 
	variable libs
	variable includes
	variable count
	variable command_count
	variable commands

   set dir [file dirname [info script]]
   if {[info command ::tcc4tcl] == ""} {
      catch { load {} tcc4tcl }
   }
   if {[info command ::tcc4tcl] == ""} {
       load [file join $dir tcc4tcl[info sharedlibextension]] tcc4tcl
   }
   set libs $dir/lib
   set includes $dir/include
   set count 0
   set command_count 0
   array set commands {}
   proc new {} {
       variable dir
       variable count
       set handle tcc_[incr count]
       tcc4tcl $dir $handle
       return tcc_$count
   }
   proc tclcommand {handle name ccode} {
       variable commands
       variable command_count
       set cname _tcc_tcl_command_[incr command_count]
       set code    {#include "tcl.h"}
	set dir [file dirname [info script]]
	if {[info command ::tcc4tcl] == ""} {
		catch { load {} tcc4tcl }
	}
	if {[info command ::tcc4tcl] == ""} {
		load [file join $dir tcc4tcl[info sharedlibextension]] tcc4tcl
	}

	set libs $dir/lib
	set includes $dir/include
	set count 0
	set command_count 0
	array set commands {}

	proc new {{output "memory"}} {
		variable dir
		variable count

		set handle tcc_[incr count]
		tcc4tcl $dir $output $handle

		return $handle
	}

	proc tclcommand {handle name ccode} {
		variable commands
		variable command_count

		set cname _tcc_tcl_command_[incr command_count]

		set code    {#include "tcl.h"}
       append code "\n int $cname"
       append code "(ClientData cdata,Tcl_Interp *interp,int objc,Tcl_Obj* CONST objv[]){"
       append code "\n$ccode"
       append code "}"
       $handle compile $code
       set commands($handle,$name) $cname
       return
   }
   proc compile {handle} {
       variable commands
       foreach cmd [array names commands $handle*] {
		append code "\nint $cname(ClientData cdata,Tcl_Interp *interp,int objc,Tcl_Obj* CONST objv\[\]) \{"
		append code "\n$ccode"
		append code "\}"

		$handle compile $code

		set commands($handle,$name) $cname

		return
	}

	proc compile {handle} {
		variable commands

		foreach cmd [array names commands ${handle},*] {
           puts $cmd
           puts $commands($cmd)
           set cname $commands($cmd)
           set tclcommand [join [lrange [split $cmd ,] 1 end] {}]
           set handle [lindex [split $cmd ,] 0]
           $handle command $tclcommand $cname
        }
       return
   }
			set cname $commands($cmd)
			set tclcommand [join [lrange [split $cmd ,] 1 end] {}]

			set handle [lindex [split $cmd ,] 0]

			$handle command $tclcommand $cname
		}

		return
	}
}

proc tcc4tcl::to_dll {code dll {libs {}}} {
    tcc4tcl $::tcc4tcl::dir dll tcc_1
    foreach lib $libs {tcc_1 add_library $lib}
    if {$::tcl_platform(platform) eq "windows"} {
        tcc_1 define DLL_EXPORT {__declspec(dllexport)} 
        set f [open $::tcc4tcl::dir/c/dllcrt1.c]
        tcc_1 compile [read $f]
        close $f
        set f [open $::tcc4tcl::dir/c/dllmain.c]
        tcc_1 compile [read $f]
        close $f
    } else {
        tcc_1 define DLL_EXPORT ""
    }
    tcc_1 compile $code
    tcc_1 output_file $dll
    rename tcc_1 {}
	set handle [::tcc4tcl::new dll]
	foreach lib $libs {
		$handle add_library $lib
	}

	if {$::tcl_platform(platform) eq "windows"} {
		$handle define DLL_EXPORT {__declspec(dllexport)} 

		set f [open [file join $::tcc4tcl::dir c dllcrt1.c]]
		$handle compile [read $f]
		close $f

		set f [open [file join $::tcc4tcl::dir c dllmain.c]]
		$handle compile [read $f]
		close $f
	} else {
		$handle define DLL_EXPORT ""
	}

	$handle compile $code
	$handle output_file $dll

	rename $handle {}
}
proc ::tcc4tcl::Log {args} {
  # puts $args
	# puts $args
}
proc ::tcc4tcl::reset {} {
  variable tcc
  set tcc(code)   ""
  set tcc(cfiles) [list]
  set tcc(tk) 0
	variable tcc
	set tcc(code)   ""
	set tcc(cfiles) [list]
	set tcc(tk) 0
}
# Custom helpers
proc ::tcc4tcl::checkname {n} {expr {[regexp {^[a-zA-Z0-9_]+$} $n] > 0}}
proc ::tcc4tcl::cleanname {n} {regsub -all {[^a-zA-Z0-9_]+} $n _}

proc ::tcc4tcl::ccode {code} {
  variable tcc
  Log "INJECTING CCODE"
  append tcc(code) $code \n
	variable tcc

	Log "INJECTING CCODE"

	append tcc(code) $code \n
}
proc ::tcc4tcl::cc {code} {
  variable tcc
  if {![info exists tcc(cc)]} {
      set tcc(cc) tcc1
	variable tcc

	if {![info exists tcc(cc)]} {
		set tcc(cc) [::tcc4tcl::new]
      tcc4tcl $::tcc4tcl::dir $tcc(cc)
  }
  Log code:$code
  $tcc(cc) compile $code
	}

	Log code:$code
	$tcc(cc) compile $code
}

#----------------------------------------------------------- New DLL API
namespace eval ::tcc4tcl::dll {}
proc ::tcc4tcl::dll {{name ""}} {
    variable count
    if {$name eq ""} {set name dll[incr count]}
    namespace eval ::tcc4tcl::dll::$name {
        variable code "#include <tcl.h>\n" ;# always needed
        variable cmds {}
    }
    proc ::$name {cmd args} "::tcc4tcl::dll::\$cmd $name \$args"
    return $name
	variable count

	if {$name eq ""} {
		set name dll[incr count]
	}

	namespace eval ::tcc4tcl::dll::$name {
		variable code "#include <tcl.h>\n" ;# always needed
		variable cmds {}
	}

	proc ::$name {cmd args} "::tcc4tcl::dll::\$cmd $name \$args"
	return $name
}
namespace eval ::tcc4tcl::dll {}

proc ::tcc4tcl::dll::ccode {name argl} {
    append ${name}::code \n [lindex $argl 0]
    return
	append ${name}::code "\n" [lindex $argl 0]

	return
}

proc ::tcc4tcl::dll::cproc {name argl} {
    foreach {pname pargs rtype body} $argl break
    set code [::tcc4tcl::wrapCmd $pname $pargs $rtype cx_$pname $body]
    lappend ${name}::cmds $pname cx_$pname
    append ${name}::code \n $code
    return
	foreach {pname pargs rtype body} $argl break

	set code [::tcc4tcl::wrapCmd $pname $pargs $rtype cx_$pname $body]

	lappend ${name}::cmds $pname cx_$pname
	append ${name}::code "\n" $code

	return
}

proc ::tcc4tcl::dll::write {name argl} {
    set (-dir) .
    set (-code) "" ;# possible extra code to go into the _Init function
    set (-libs) ""
    set (-name) [string tolower $name]
    array set "" $argl
    append ${name}::code \n \
        [::tcc4tcl::wrapExport $(-name) [set ${name}::cmds] $(-code)]
    set outfile $(-dir)/$(-name)[info sharedlibextension]
    ::tcc4tcl::to_dll [set ${name}::code] $outfile $(-libs)
	set (-dir) .
	set (-code) "" ;# possible extra code to go into the _Init function
	set (-libs) ""
	set (-name) [string tolower $name]
	array set "" $argl

	append ${name}::code "\n" \
		[::tcc4tcl::wrapExport $(-name) [set ${name}::cmds] $(-code)]

	set outfile $(-dir)/$(-name)[info sharedlibextension]

	::tcc4tcl::to_dll [set ${name}::code] $outfile $(-libs)
}

#---------------------------------------------------------------------
proc ::tcc4tcl::wrap {name adefs rtype {body "#"}} {
  set cname c_[string map [list ":" "_"] $name]
  set wname tcl_$name
  array set types {}
  set names {}
  set cargs {}
  set cnames {}  
  # if first arg is "Tcl_Interp*", pass it without counting it as a cmd arg
  if {[lindex $adefs 0] eq "Tcl_Interp*"} {
    lappend cnames ip
    lappend cargs [lrange $adefs 0 1]
    set adefs [lrange $adefs 2 end]
  }
  foreach {t n} $adefs {
    set types($n) $t
    lappend names $n
    lappend cnames _$n
    lappend cargs "$t $n"
  }
  switch -- $rtype {
    ok      { set rtype2 "int" }
    string - dstring - vstring { set rtype2 "char*" }
    default { set rtype2 $rtype }
  }
  set code ""
  append code "\n#include <tcl.h>" "\n"
  if {[info exists tcc(tk)] && $tcc(tk)} {
    append code "\#include <tk.h>" "\n"
  }
  if {$body ne "#"} {
    append code "static $rtype2" "\n"
	set cname c_[tcc4tcl::cleanname $name]
	set wname tcl_$name
	array set types {}
	set varnames {}
	set cargs {}
	set cnames {}  
	set cbody {}
	set code {}

	# if first arg is "Tcl_Interp*", pass it without counting it as a cmd arg
	if {[lindex $adefs 0] eq "Tcl_Interp*"} {
		lappend cnames ip
		lappend cargs [lrange $adefs 0 1]
		set adefs [lrange $adefs 2 end]
	}

	foreach {t n} $adefs {
		set types($n) $t
		lappend varnames $n
		lappend cnames _$n
		lappend cargs "$t $n"
	}

	# Handle return type
	switch -- $rtype {
		ok      {
			set rtype2 "int"
		}
		string - dstring - vstring {
			set rtype2 "char*"
		}
		default {
			set rtype2 $rtype
		}
	}

	append code "#include <tcl.h>\n"
	if {[info exists tcc(tk)] && $tcc(tk)} {
		append code "#include <tk.h>\n"
	}

	# Create wrapped function
	if {$body ne "#"} {
		append code "static $rtype2 ${cname}([join $cargs {, }]) \{\n"
    append code "${cname}([join $cargs {, }]) \{\n"
    append code $body
    append code "\}" "\n"
  } else {
    append code "#define $cname $name" "\n"
  }
  # Supported input types
  #   Tcl_Interp*
  #   int
  #   long
  #   float
  #   double
  #   char*
  #   Tcl_Obj*
  #   void*
  foreach x $names {
    set t $types($x)
    switch -- $t {
      int - long - float - double - char* - Tcl_Obj* {
          append cbody "  $types($x) _$x;" "\n"
      }
      default {append cbody "  void *_$x;" "\n"}
    }
  }
  if {$rtype ne "void"} { append cbody  "  $rtype2 rv;" "\n" }  
  append cbody "  if (objc != [expr {[llength $names] + 1}]) {" "\n"
  append cbody "    Tcl_WrongNumArgs(ip, 1, objv, \"[join $names { }]\");\n"
  append cbody "    return TCL_ERROR;" "\n"
  append cbody "  }" "\n"
  set n 0
  foreach x $names {
    incr n
    switch -- $types($x) {
      int {
	append cbody "  if (Tcl_GetIntFromObj(ip, objv\[$n], &_$x) != TCL_OK)"
	append cbody "    return TCL_ERROR;" "\n"
      }
      long {
	append cbody "  if (Tcl_GetLongFromObj(ip, objv\[$n], &_$x) != TCL_OK)"
	append cbody "    return TCL_ERROR;" "\n"
      }
      float {
	append cbody "  {" "\n"
	append cbody "    double t;" "\n"
	append cbody "    if (Tcl_GetDoubleFromObj(ip, objv\[$n], &t) != TCL_OK)"
	append cbody "      return TCL_ERROR;" "\n"
	append cbody "    _$x = (float) t;" "\n"
	append cbody "  }" "\n"
      }
      double {
	append cbody "  if (Tcl_GetDoubleFromObj(ip, objv\[$n], &_$x) != TCL_OK)"
	append cbody "    return TCL_ERROR;" "\n"
      }
      char* {
	append cbody "  _$x = Tcl_GetString(objv\[$n]);" "\n"
      }
      default {
	append cbody "  _$x = objv\[$n];" "\n"
      }
    }
  }
  append cbody "\n  "
  if {$rtype != "void"} {append cbody "rv = "}
  append cbody "${cname}([join $cnames {, }]);" "\n"
  # Return types supported by critcl
  #   void
  #   ok
  #   int
  #   long
  #   float
  #   double
  #   char*     (TCL_STATIC char*)
  #   string    (TCL_DYNAMIC char*)
  #   dstring   (TCL_DYNAMIC char*)
  #   vstring   (TCL_VOLATILE char*)
  #   default   (Tcl_Obj*)
		append code $body
		append code "\}\n"
	} else {
		append code "#define $cname $name" "\n"
	}

	# Create wrapper function
	## Supported input types
	##   Tcl_Interp*
	##   int
	##   long
	##   float
	##   double
	##   char*
	##   Tcl_Obj*
	##   void*
	foreach x $varnames {
		set t $types($x)

		switch -- $t {
			int - long - float - double - char* - Tcl_Obj* {
				append cbody "  $types($x) _$x;" "\n"
			}
			default {
				append cbody "  void *_$x;" "\n"
			}
		}
	}

	if {$rtype ne "void"} {
		append cbody  "  $rtype2 rv;" "\n"
	}  

	append cbody "  if (objc != [expr {[llength $varnames] + 1}]) {" "\n"
	append cbody "    Tcl_WrongNumArgs(ip, 1, objv, \"[join $varnames { }]\");\n"
	append cbody "    return TCL_ERROR;" "\n"
	append cbody "  }" "\n"

	set n 0
	foreach x $varnames {
		incr n
		switch -- $types($x) {
			int {
				append cbody "  if (Tcl_GetIntFromObj(ip, objv\[$n], &_$x) != TCL_OK)"
				append cbody "    return TCL_ERROR;" "\n"
			}
			long {
				append cbody "  if (Tcl_GetLongFromObj(ip, objv\[$n], &_$x) != TCL_OK)"
				append cbody "    return TCL_ERROR;" "\n"
			}
			float {
				append cbody "  {" "\n"
				append cbody "    double t;" "\n"
				append cbody "    if (Tcl_GetDoubleFromObj(ip, objv\[$n], &t) != TCL_OK)"
				append cbody "      return TCL_ERROR;" "\n"
				append cbody "    _$x = (float) t;" "\n"
				append cbody "  }" "\n"
			}
			double {
				append cbody "  if (Tcl_GetDoubleFromObj(ip, objv\[$n], &_$x) != TCL_OK)"
				append cbody "    return TCL_ERROR;" "\n"
			}
			char* {
				append cbody "  _$x = Tcl_GetString(objv\[$n]);" "\n"
			}
			default {
				append cbody "  _$x = objv\[$n];" "\n"
			}
		}
	}
	append cbody "\n"

	# Call wrapped function
	if {$rtype != "void"} {
		append cbody "rv = "
	}
	append cbody "${cname}([join $cnames {, }]);" "\n"

	# Return types supported by critcl
	#   void
	#   ok
	#   int
	#   long
	#   float
	#   double
	#   char*     (TCL_STATIC char*)
	#   string    (TCL_DYNAMIC char*)
	#   dstring   (TCL_DYNAMIC char*)
	#   vstring   (TCL_VOLATILE char*)
	#   default   (Tcl_Obj*)
  # Our extensions
  #   wide
  switch -- $rtype {
    void    	{ }
    ok	        { append cbody "  return rv;" "\n" }
    int	        { append cbody "  Tcl_SetIntObj(Tcl_GetObjResult(ip), rv);" "\n" }
    long	{ append cbody "  Tcl_SetLongObj(Tcl_GetObjResult(ip), rv);" "\n" }
    float       -
    double	{ append cbody "  Tcl_SetDoubleObj(Tcl_GetObjResult(ip), rv);" "\n" }
    char*	{ append cbody "  Tcl_SetResult(ip, rv, TCL_STATIC);" "\n" }
    string      -
    dstring	{ append cbody "  Tcl_SetResult(ip, rv, TCL_DYNAMIC);" "\n" }
    vstring	{ append cbody "  Tcl_SetResult(ip, rv, TCL_VOLATILE);" "\n" }
    default 	{ append cbody "  Tcl_SetObjResult(ip, rv); Tcl_DecrRefCount(rv);" "\n" }
  }
  if {$rtype != "ok"} {append cbody "  return TCL_OK;" \n}

  #puts ----code:\n$code
	#   wide
	switch -- $rtype {
		void           { }
		ok             { append cbody "  return rv;" "\n" }
		int            { append cbody "  Tcl_SetIntObj(Tcl_GetObjResult(ip), rv);" "\n" }
		long           { append cbody "  Tcl_SetLongObj(Tcl_GetObjResult(ip), rv);" "\n" }
		float          -
		double         { append cbody "  Tcl_SetDoubleObj(Tcl_GetObjResult(ip), rv);" "\n" }
		char*          { append cbody "  Tcl_SetResult(ip, rv, TCL_STATIC);" "\n" }
		string         -
		dstring        { append cbody "  Tcl_SetResult(ip, rv, TCL_DYNAMIC);" "\n" }
		vstring        { append cbody "  Tcl_SetResult(ip, rv, TCL_VOLATILE);" "\n" }
		default        { append cbody "  Tcl_SetObjResult(ip, rv); Tcl_DecrRefCount(rv);" "\n" }
	}

	if {$rtype != "ok"} {
		append cbody "  return TCL_OK;\n"
	}

  #puts ----cbody:\n$cbody
  list $code $cbody
	return [list $code $cbody]
}

proc ::tcc4tcl::wrapCmd {tclname argl rtype cname body} {
    foreach {code cbody} [wrap $tclname $argl $rtype $body] break
    append code "\nstatic int $cname"
    append code {(ClientData cdata,Tcl_Interp *ip,
        int objc,Tcl_Obj* CONST objv[])} " \{"
    append code \n$cbody \n\}\n
	foreach {code cbody} [wrap $tclname $argl $rtype $body] break

	append code "\nstatic int $cname(ClientData cdata,Tcl_Interp *ip, int objc,Tcl_Obj* CONST objv\[\]) \{\n"
	append code "\n$cbody\n\}\n"

	return $code
}

proc ::tcc4tcl::wrapExport {name cmds {body ""}} {
    set code "DLL_EXPORT int [string totitle $name]_Init(Tcl_Interp *interp)"
    append code " \{\n"
    foreach {tclname cname} $cmds {
	set code "DLL_EXPORT int [string totitle $name]_Init(Tcl_Interp *interp) \{\n"

	foreach {tclname cname} $cmds {
        append code \
            "Tcl_CreateObjCommand(interp,\"$tclname\",$cname,NULL,NULL);\n"
    }
    append code $body
    append code "\nreturn TCL_OK;\n\}"
}
		append code "Tcl_CreateObjCommand(interp, \"$tclname\", $cname, NULL, NULL);\n"
	}

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

	return $code
}

#---------------------------------------------------------------------
proc ::tcc4tcl::cproc {name adefs rtype {body "#"}} {
  foreach {code cbody} [wrap $name $adefs $rtype $body] break
  ccode $code
  set ns [namespace current]
  uplevel 1 [list ${ns}::ccommand $name {dummy ip objc objv} $cbody]
	foreach {code cbody} [wrap $name $adefs $rtype $body] break

	::tcc4tcl::ccode $code

	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
    set inittext "\n"
  set line ""
  set n 0
  set l 0
  foreach c $bytes {
    if {$n>0} {append inittext ","}
    if {$l>20} {
      append inittext "\n"
      set l 0
    }
    if {$l==0} {append inittext "  "}
    append inittext [format "0x%02X" [expr {$c & 0xff}]]
    incr n
    incr l
  }
  append inittext "\n"
  set count [llength $bytes]  
  set cbody ""
  append cbody "static unsigned char script\[$count\] = \{" "\n"
  append cbody $inittext
  append cbody "\};" "\n"
  append cbody "Tcl_SetByteArrayObj(Tcl_GetObjResult(ip), (unsigned char*) script, $count);\n"
  append cbody "return TCL_OK;" "\n"
  set ns [namespace current]
  uplevel 1 [list ${ns}::ccommand $name {dummy ip objc objv} $cbody]
  return $name
	# Extract bytes from data
	binary scan $data c* bytes

	set inittext "\n"
	set line ""
	set n 0
	set l 0
	foreach c $bytes {
		if {$n > 0} {
			append inittext ","
		}
		if {$l > 20} {
			append inittext "\n"
			set l 0
		}

		if {$l==0} {
			append inittext "  "
		}

		append inittext [format "0x%02X" [expr {$c & 0xff}]]
		incr n
		incr l
	}

	append inittext "\n"

	set count [llength $bytes]  

	set cbody ""
	append cbody "static unsigned char script\[$count\] = \{" "\n"
	append cbody $inittext
	append cbody "\};" "\n"

	append cbody "Tcl_SetByteArrayObj(Tcl_GetObjResult(ip), (unsigned char*) script, $count);\n"
	append cbody "return TCL_OK;" "\n"

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

	return $name
}

#-------------------------------------------------------------------
proc ::tcc4tcl::ccommand {procname anames args} {
  variable tcc
  # Fully qualified proc name
  if {[string match "::*" $procname]} {
    # procname is already absolute
  } else {
    set nsfrom [uplevel 1 {namespace current}]    
    if {$nsfrom eq "::"} {set nsfrom ""}
    set procname "${nsfrom}::${procname}"
  }      
  set v(clientdata) clientdata
  set v(interp)     interp
  set v(objc)       objc
  set v(objv)       objv
  set id 0
  foreach defname {clientdata interp objc objv} {
    if {[llength $anames]>$id} {
      set vname [lindex $anames $id]
      if {![checkname $vname]} {
	error "invalid variable name \"$vname\""
      }
    } else {set vname $defname}
    set v($defname) $vname
    incr id
  }
  set cname Cmd_N${id}_[cleanname $procname]
  set code ""
  if {[info exists tcc(tk)] && $tcc(tk)} {
    append code "\#include <tk.h>" "\n"
  }
  if {[info exists tcc(code)] && [string length $tcc(code)]>0} {
    append code $tcc(code)
    append code "\n"
  }
  append code "int $cname (ClientData $v(clientdata),Tcl_Interp *$v(interp),"
  append code "int $v(objc),Tcl_Obj *CONST $v(objv)\[\]) {" "\n"
  append code [lindex $args end] "\n"
  append code "}" "\n"
  set ns [namespace current]
  uplevel 1 [list ${ns}::cc $code]
  Log "CREATING TCL COMMAND $procname / $cname"
  uplevel 1 [list $tcc(cc) command $procname $cname]
  unset tcc(cc) ;# can't be used for compiling anymore
	variable tcc

	# Fully qualified proc name
	if {[string match "::*" $procname]} {
		# procname is already absolute
	} else {
		set nsfrom [uplevel 1 {namespace current}]    
		if {$nsfrom eq "::"} {
			set nsfrom ""
		}

		set procname "${nsfrom}::${procname}"
	}

	set v(clientdata) clientdata
	set v(interp)     interp
	set v(objc)       objc
	set v(objv)       objv

	set id 0

	foreach defname {clientdata interp objc objv} {
		if {[llength $anames] > $id} {
			set vname [lindex $anames $id]

			if {![checkname $vname]} {
				error "invalid variable name \"$vname\""
			}
		} else {
			set vname $defname
		}

		set v($defname) $vname

		incr id
	}

	set cname Cmd_N${id}_[cleanname $procname]
	set code ""

	if {[info exists tcc(tk)] && $tcc(tk)} {
		append code "\#include <tk.h>" "\n"
	}

	if {[info exists tcc(code)] && [string length $tcc(code)]>0} {
		append code $tcc(code)
		append code "\n"
	}

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

	uplevel 1 [list tcc4tcl::cc $code]

	Log "CREATING TCL COMMAND $procname / $cname"
	uplevel 1 [list $tcc(cc) command $procname $cname]
	unset tcc(cc) ;# can't be used for compiling anymore
}

proc ::tcc4tcl::tk {args} {
  variable tcc
  set tcc(tk) 1
	variable tcc
	set tcc(tk) 1
}

::tcc4tcl::reset
namespace eval tcc4tcl {namespace export cproc ccode cdata}

#! /usr/bin/env tclsh

lappend auto_path [lindex $argv 0]
package require tcc4tcl

tcc4tcl::cproc test {int i} int { return(i+42); }
tcc4tcl::cproc test1 {int i} int { return(i+42); }
tcc4tcl::cproc ::bob::test1 {int i} int { return(i+42); }

puts [test 1]
puts [::test1 1]
puts [::bob::test1 1]