Overview
Comment: | Updated to allow output to file (DLL/SO) to work -- but segfaults |
---|---|
Timelines: | family | ancestors | descendants | both | trunk |
Files: | files | file ages | folders |
SHA1: |
c208e3c07f03bbc4e4aa556fe7316c67 |
User & Date: | rkeene on 2014-06-18 05:05:56 |
Other Links: | manifest | tags |
Context
2014-06-18
| ||
17:03 | Updated to support output to exe check-in: 3c45d1d050 user: rkeene tags: trunk | |
05:05 | Updated to allow output to file (DLL/SO) to work -- but segfaults check-in: c208e3c07f user: rkeene tags: trunk | |
04:45 | Rewrote high-level API to support a handle-based interface check-in: daa895fdb4 user: rkeene tags: trunk | |
Changes
Modified tcc4tcl.tcl from [cdff98c77e] to [0ac3e6cbbe].
︙ | ︙ | |||
10 11 12 13 14 15 16 | } if {[info command ::tcc4tcl] == ""} { load [file join $dir tcc4tcl[info sharedlibextension]] tcc4tcl } set count 0 | | | | 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 | } if {[info command ::tcc4tcl] == ""} { load [file join $dir tcc4tcl[info sharedlibextension]] tcc4tcl } set count 0 proc new {{output ""} {pkgName ""}} { variable dir variable count set handle ::tcc4tcl::tcc_[incr count] set tcc_handle ::tcc4tcl::tcc_[incr count] if {$output == ""} { set type "memory" } else { set type "dll" } array set $handle [list tcc $tcc_handle code "" type $type filename $output package $pkgName] proc $handle {cmd args} [string map [list @@HANDLE@@ $handle] { set handle {@@HANDLE@@} uplevel 1 [list ::tcc4tcl::_$cmd $handle {*}$args] }] return $handle |
︙ | ︙ | |||
71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 | if {[info exists state(tk)]} { set state(code) "#include <tk.h>\n$state(code)" } set state(code) "#include <tcl.h>\n\n$state(code)" tcc4tcl $dir $state(type) tcc tcc compile $state(code) foreach {procname cname} $state(procs) { tcc command $procname $cname } rename $handle "" unset $handle } | > > > > > > > > > > > > > > > > > > > > > > > > > < | 71 72 73 74 75 76 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 106 107 108 109 110 111 112 113 114 115 116 117 118 | if {[info exists state(tk)]} { set state(code) "#include <tk.h>\n$state(code)" } set state(code) "#include <tcl.h>\n\n$state(code)" tcc4tcl $dir $state(type) tcc switch -- $state(type) { "memory" { tcc compile $state(code) foreach {procname cname} $state(procs) { tcc command $procname $cname } } "dll" { append state(code) "int [string totitle $state(package)]_Init(Tcl_Interp *interp) \{\n" append state(code) "#ifdef USE_TCL_STUBS\n" append state(code) " if (Tcl_InitStubs(interp, \"8.4\" , 0) == 0L) \{\n" append state(code) " return TCL_ERROR;\n" append state(code) " \}\n" append state(code) "#endif\n" foreach {procname cname} $state(procs) { append state(code) " Tcl_CreateObjCommand(interp, \"$procname\", $cname, NULL, NULL);" } append state(code) "Tcl_PkgProvide(interp, \"$state(package)\", \"0.0\");\n" append state(code) " return(TCL_OK);\n" append state(code) "\}" tcc compile $state(code) tcc output_file $state(filename) } } rename $handle "" unset $handle } } 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::cproc {name adefs rtype {body "#"}} { set handle [::tcc4tcl::new] |
︙ | ︙ |