Overview
| Comment: | Added a command called "code" to get the generated code |
|---|---|
| Timelines: | family | ancestors | descendants | both | trunk |
| Files: | files | file ages | folders |
| SHA1: |
1a7d494008f59c433c1303970742640f |
| User & Date: | rkeene on 2014-06-18 19:46:13 |
| Other Links: | manifest | tags |
Context
|
2014-06-18
| ||
| 19:50 | Added new API tests check-in: 2a9dcf9840 user: rkeene tags: trunk | |
| 19:46 | Added a command called "code" to get the generated code check-in: 1a7d494008 user: rkeene tags: trunk | |
| 19:04 | Updated to use pointerSize to determine 32/64-bit library paths so that i386 code can be emitted when running a 32-bit Tcl on a 64-bit box check-in: 0d7d9afa0a user: rkeene tags: trunk | |
Changes
Modified tcc4tcl.tcl from [9e249ac45d] to [602c05c493].
31 31 } 32 32 } 33 33 34 34 array set $handle [list tcc $tcc_handle code "" type $type filename $output package $pkgName] 35 35 36 36 proc $handle {cmd args} [string map [list @@HANDLE@@ $handle] { 37 37 set handle {@@HANDLE@@} 38 + if {$cmd == "go"} { 39 + set args [list 0 {*}$args] 40 + } 41 + 42 + if {$cmd == "code"} { 43 + set cmd "go" 44 + set args [list 1 {*}$args] 45 + } 46 + 38 47 uplevel 1 [list ::tcc4tcl::_$cmd $handle {*}$args] 39 48 }] 40 49 41 50 return $handle 42 51 } 43 52 44 53 proc _cproc {handle name adefs rtype {body "#"}} { ................................................................................ 55 64 56 65 lappend state(procs) $name $tclname 57 66 } 58 67 59 68 proc _ccode {handle code} { 60 69 upvar #0 $handle state 61 70 62 - append state(code) $code 71 + append state(code) $code "\n" 63 72 } 64 73 65 74 proc _tk {handle} { 66 75 upvar #0 $handle state 67 76 68 77 set state(tk) 1 69 78 } 70 79 71 - proc _go {handle} { 80 + proc _go {handle {outputOnly 0}} { 72 81 variable dir 73 82 74 83 upvar #0 $handle state 84 + 85 + set code $state(code) 75 86 76 87 if {[info exists state(tk)]} { 77 - set state(code) "#include <tk.h>\n$state(code)" 88 + set code "#include <tk.h>\n$code" 78 89 } 79 - set state(code) "#include <tcl.h>\n\n$state(code)" 90 + set code "#include <tcl.h>\n\n$code" 80 91 81 92 # Append additional generated code to support the output type 82 93 switch -- $state(type) { 83 94 "memory" { 84 95 # No additional code needed 96 + if {$outputOnly} { 97 + if {[info exists state(procs)] && [llength $state(procs)] > 0} { 98 + foreach {procname cname} $state(procs) { 99 + append code "/* Immediate: Tcl_CreateObjCommand(interp, \"$procname\", $cname, NULL, NULL); */\n" 100 + } 101 + } 102 + } 85 103 } 86 104 "exe" - "dll" { 87 105 if {[info exists state(procs)] && [llength $state(procs)] > 0} { 88 - append state(code) "int _initProcs(Tcl_Interp *interp) \{\n" 106 + append code "int _initProcs(Tcl_Interp *interp) \{\n" 89 107 90 108 foreach {procname cname} $state(procs) { 91 - append state(code) " Tcl_CreateObjCommand(interp, \"$procname\", $cname, NULL, NULL);" 109 + append code " Tcl_CreateObjCommand(interp, \"$procname\", $cname, NULL, NULL);\n" 92 110 } 93 111 94 - append state(code) "\}" 112 + append code "\}" 95 113 } 96 114 } 97 115 "package" { 98 116 set packageName [lindex $state(package) 0] 99 117 set packageVersion [lindex $state(package) 1] 100 118 if {$packageVersion == ""} { 101 119 set packageVersion "0" 102 120 } 103 121 104 - append state(code) "int [string totitle $packageName]_Init(Tcl_Interp *interp) \{\n" 105 - append state(code) "#ifdef USE_TCL_STUBS\n" 106 - append state(code) " if (Tcl_InitStubs(interp, \"8.4\" , 0) == 0L) \{\n" 107 - append state(code) " return TCL_ERROR;\n" 108 - append state(code) " \}\n" 109 - append state(code) "#endif\n" 122 + append code "int [string totitle $packageName]_Init(Tcl_Interp *interp) \{\n" 123 + append code "#ifdef USE_TCL_STUBS\n" 124 + append code " if (Tcl_InitStubs(interp, \"8.4\" , 0) == 0L) \{\n" 125 + append code " return TCL_ERROR;\n" 126 + append code " \}\n" 127 + append code "#endif\n" 110 128 111 129 if {[info exists state(procs)] && [llength $state(procs)] > 0} { 112 130 foreach {procname cname} $state(procs) { 113 - append state(code) " Tcl_CreateObjCommand(interp, \"$procname\", $cname, NULL, NULL);" 131 + append code " Tcl_CreateObjCommand(interp, \"$procname\", $cname, NULL, NULL);\n" 114 132 } 115 133 } 116 134 117 - append state(code) "Tcl_PkgProvide(interp, \"$packageName\", \"$packageVersion\");\n" 118 - append state(code) " return(TCL_OK);\n" 119 - append state(code) "\}" 135 + append code " Tcl_PkgProvide(interp, \"$packageName\", \"$packageVersion\");\n" 136 + append code " return(TCL_OK);\n" 137 + append code "\}" 120 138 } 121 139 } 140 + 141 + if {$outputOnly} { 142 + return $code 143 + } 122 144 123 145 # Generate output code 124 146 switch -- $state(type) { 125 147 "package" { 126 148 set tcc_type "dll" 127 149 } 128 150 default { 129 151 set tcc_type $state(type) 130 152 } 131 153 } 154 + 132 155 tcc4tcl $dir $tcc_type tcc 133 156 134 157 switch -- $state(type) { 135 158 "memory" { 136 - tcc compile $state(code) 159 + tcc compile $code 137 160 138 - foreach {procname cname} $state(procs) { 139 - tcc command $procname $cname 161 + if {[info exists state(procs)] && [llength $state(procs)] > 0} { 162 + foreach {procname cname} $state(procs) { 163 + tcc command $procname $cname 164 + } 140 165 } 141 166 } 142 167 143 168 "package" - "dll" - "exe" { 144 169 switch -glob -- $::tcl_platform(os)-$::tcl_platform(pointerSize) { 145 170 "Linux-8" { 146 171 tcc add_library_path "/lib64" 147 172 tcc add_library_path "/usr/lib64" 148 173 tcc add_library_path "/lib" 149 174 tcc add_library_path "/usr/lib" 150 175 } 176 + "SunOS-8" { 177 + tcc add_library_path "/lib/64" 178 + tcc add_library_path "/usr/lib/64" 179 + tcc add_library_path "/lib" 180 + tcc add_library_path "/usr/lib" 181 + } 151 182 "Linux-*" { 152 183 tcc add_library_path "/lib32" 153 184 tcc add_library_path "/usr/lib32" 154 185 tcc add_library_path "/lib" 155 186 tcc add_library_path "/usr/lib" 156 187 } 157 188 default { ................................................................................ 158 189 if {$::tcl_platform(platform) == "unix"} { 159 190 tcc add_library_path "/lib" 160 191 tcc add_library_path "/usr/lib" 161 192 } 162 193 } 163 194 } 164 195 165 - tcc compile $state(code) 196 + tcc compile $code 166 197 167 198 tcc output_file $state(filename) 168 199 } 169 200 } 170 201 171 202 # Cleanup 172 203 rename $handle ""