tcc4tcl
Check-in [c208e3c07f]
Login
HomeTimelineFilesBranchesTagsTicketsWiki
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: c208e3c07f03bbc4e4aa556fe7316c67a155ca0e
User & Date: rkeene on 2014-06-18 05:05:56.587
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
Side-by-Side Diff Ignore Whitespace Patch
Modified tcc4tcl.tcl from [cdff98c77e] to [0ac3e6cbbe].
︙
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

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 ""}} {
	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]
		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
87
88
89
90
91
92
93
94

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)
				tcc compile $state(code)

		foreach {procname cname} $state(procs) {
			tcc command $procname $cname
				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]
︙
Powered by Fossil · RSS