1 2 3 4 5 6 7 8 9 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 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 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 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390
|
###
# In the end, all C code must be loaded into a module
# This will either be a dynamically loaded library implementing
# a tcl extension, or a compiled in segment of a custom shell/app
###
::clay::define ::practcl::module {
superclass ::practcl::object ::practcl::product.dynamic
Dict make_object {}
method _MorphPatterns {} {
return {{@name@} {::practcl::module.@name@} ::practcl::module}
}
method add args {
my variable links
set object [::practcl::object new [self] {*}$args]
foreach linktype [$object linktype] {
lappend links($linktype) $object
}
return $object
}
method install-headers args {}
Ensemble make::_preamble {} {
my variable make_object
if {![info exists make_object]} {
set make_object {}
}
}
Ensemble make::pkginfo {} {
###
# Build local variables needed for install
###
package require platform
set result {}
set dat [my define dump]
set PKG_DIR [dict get $dat name][dict get $dat version]
dict set result PKG_DIR $PKG_DIR
dict with dat {}
if {![info exists DESTDIR]} {
set DESTDIR {}
}
dict set result profile [::platform::identify]
dict set result os $::tcl_platform(os)
dict set result platform $::tcl_platform(platform)
foreach {field value} $dat {
switch $field {
includedir -
mandir -
datadir -
libdir -
libfile -
name -
output_tcl -
version -
authors -
license -
requires {
dict set result $field $value
}
TEA_PLATFORM {
dict set result platform $value
}
TEACUP_OS {
dict set result os $value
}
TEACUP_PROFILE {
dict set result profile $value
}
TEACUP_ZIPFILE {
dict set result zipfile $value
}
}
}
if {![dict exists $result zipfile]} {
dict set result zipfile "[dict get $result name]-[dict get $result version]-[dict get $result profile].zip"
}
return $result
}
# Return a dictionary of all handles and associated objects
Ensemble make::objects {} {
return $make_object
}
# Return the object associated with handle [emph name]
Ensemble make::object name {
if {[dict exists $make_object $name]} {
return [dict get $make_object $name]
}
return {}
}
# Reset all deputy objects
Ensemble make::reset {} {
foreach {name obj} $make_object {
$obj reset
}
}
# Exercise the triggers method for all handles listed
Ensemble make::trigger args {
foreach {name obj} $make_object {
if {$name in $args} {
$obj triggers
}
}
}
# Exercise the check method for all handles listed
Ensemble make::depends args {
foreach {name obj} $make_object {
if {$name in $args} {
$obj check
}
}
}
# Return the file name of the build product for the listed
# handle
Ensemble make::filename name {
if {[dict exists $make_object $name]} {
return [[dict get $make_object $name] define get filename]
}
}
Ensemble make::target {name Info body} {
set info [uplevel #0 [list subst $Info]]
set nspace [namespace current]
if {[dict exist $make_object $name]} {
set obj [dict get $$make_object $name]
} else {
set obj [::practcl::make_obj new [self] $name $info $body]
dict set make_object $name $obj
dict set target_make $name 0
dict set target_trigger $name 0
}
if {[dict exists $info aliases]} {
foreach item [dict get $info aliases] {
if {![dict exists $make_object $item]} {
dict set make_object $item $obj
}
}
}
return $obj
}
clay set method_ensemble make target aliases {target add}
# Return a list of handles for object which return true for the
# do method
Ensemble make::todo {} {
foreach {name obj} $make_object {
if {[$obj do]} {
lappend result $name
}
}
return $result
}
# For each target exercise the action specified in the [emph action]
# definition if the [emph do] method returns true
Ensemble make::do {} {
global CWD SRCDIR project SANDBOX
foreach {name obj} $make_object {
if {[$obj do]} {
eval [$obj define get action]
}
}
}
method child which {
switch $which {
delegate -
organs {
return [list project [my define get project] module [self]]
}
}
}
###
# This methods generates the contents of an amalgamated .c file
# which implements the loader for a batch of tools
###
method generate-c {} {
::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]]
set result {
/* This file was generated by practcl */
}
set includes {}
foreach mod [my link list product] {
# Signal modules to formulate final implementation
$mod go
}
set headers {}
my IncludeAdd headers <tcl.h> <tclOO.h>
if {[my define get tk 0]} {
my IncludeAdd headers <tk.h>
}
if {[my define get output_h] ne {}} {
my IncludeAdd headers [my define get output_h]
}
my IncludeAdd headers {*}[my define get include]
foreach mod [my link list dynamic] {
my IncludeAdd headers {*}[$mod define get include]
}
foreach inc $headers {
::practcl::cputs result "#include $inc"
}
foreach {method} {
generate-cfile-header
generate-cfile-private-typedef
generate-cfile-private-structure
generate-cfile-public-structure
generate-cfile-constant
generate-cfile-global
generate-cfile-functions
generate-cfile-tclapi
} {
set dat [my $method]
if {[string length [string trim $dat]]} {
::practcl::cputs result "/* BEGIN $method [my define get filename] */"
::practcl::cputs result $dat
::practcl::cputs result "/* END $method [my define get filename] */"
}
}
::practcl::debug [list /[self] [self method] [self class] -- [my define get filename] [info object class [self]]]
return $result
}
###
# This methods generates the contents of an amalgamated .h file
# which describes the public API of this module
###
method generate-h {} {
::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]]
set result {}
foreach method {
generate-hfile-public-define
generate-hfile-public-macro
} {
::practcl::cputs result "/* BEGIN SECTION $method */"
::practcl::cputs result [my $method]
::practcl::cputs result "/* END SECTION $method */"
}
set includes [my generate-hfile-public-includes]
foreach inc $includes {
if {[string index $inc 0] ni {< \"}} {
::practcl::cputs result "#include \"$inc\""
} else {
::practcl::cputs result "#include $inc"
}
}
foreach method {
generate-hfile-public-typedef
generate-hfile-public-structure
} {
::practcl::cputs result "/* BEGIN SECTION $method */"
::practcl::cputs result [my $method]
::practcl::cputs result "/* END SECTION $method */"
}
foreach file [my generate-hfile-public-verbatim] {
::practcl::cputs result "/* BEGIN $file */"
::practcl::cputs result [::practcl::cat $file]
::practcl::cputs result "/* END $file */"
}
foreach method {
generate-hfile-public-headers
generate-hfile-public-function
} {
::practcl::cputs result "/* BEGIN SECTION $method */"
::practcl::cputs result [my $method]
::practcl::cputs result "/* END SECTION $method */"
}
return $result
}
method generate-loader {} {
::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]]
set result {}
if {[my define get initfunc] eq {}} return
::practcl::cputs result "
extern int DLLEXPORT [my define get initfunc]( Tcl_Interp *interp ) \{"
::practcl::cputs result {
/* Initialise the stubs tables. */
#ifdef USE_TCL_STUBS
if (Tcl_InitStubs(interp, "8.6", 0)==NULL) return TCL_ERROR;
if (TclOOInitializeStubs(interp, "1.0") == NULL) return TCL_ERROR;
}
if {[my define get tk 0]} {
::practcl::cputs result { if (Tk_InitStubs(interp, "8.6", 0)==NULL) return TCL_ERROR;}
}
::practcl::cputs result { #endif}
set TCLINIT [my generate-tcl-pre]
if {[string length [string trim $TCLINIT]]} {
::practcl::cputs result " if(interp) {\nif(Tcl_Eval(interp,[::practcl::tcl_to_c $TCLINIT])) return TCL_ERROR;\n }"
}
::practcl::cputs result [my generate-loader-module]
set TCLINIT [my generate-tcl-post]
if {[string length [string trim $TCLINIT]]} {
::practcl::cputs result " if(interp) {\nif(Tcl_Eval(interp,[::practcl::tcl_to_c $TCLINIT])) return TCL_ERROR;\n }"
}
if {[my define exists pkg_name]} {
::practcl::cputs result " if (Tcl_PkgProvide(interp, \"[my define get pkg_name [my define get name]]\" , \"[my define get pkg_vers [my define get version]]\" )) return TCL_ERROR\;"
}
::practcl::cputs result " return TCL_OK\;\n\}\n"
return $result
}
method initialize {} {
set filename [my define get filename]
if {$filename eq {}} {
return
}
if {[my define get name] eq {}} {
my define set name [file tail [file dirname $filename]]
}
if {[my define get localpath] eq {}} {
my define set localpath [my <project> define get name]_[my define get name]
}
my graft module [self]
::practcl::debug [self] SOURCE $filename
my source $filename
}
method implement path {
my go
my Collate_Source $path
set errs {}
foreach item [my link list dynamic] {
if {[catch {$item implement $path} err errdat]} {
lappend errs "Skipped $item: [$item define get filename] $err"
if {[dict exists $errdat -errorinfo]} {
lappend errs [dict get $errdat -errorinfo]
} else {
lappend errs $errdat
}
}
}
foreach item [my link list module] {
if {[catch {$item implement $path} err errdat]} {
lappend errs "Skipped $item: [$item define get filename] $err"
if {[dict exists $errdat -errorinfo]} {
lappend errs [dict get $errdat -errorinfo]
} else {
lappend errs $errdat
}
}
}
if {[llength $errs]} {
set logfile [file join $::CWD practcl.log]
::practcl::log $logfile "*** ERRORS ***"
foreach {item trace} $errs {
::practcl::log $logfile "###\n# ERROR\n###\n$item"
::practcl::log $logfile "###\n# TRACE\n###\n$trace"
}
::practcl::log $logfile "*** DEBUG INFO ***"
::practcl::log $logfile $::DEBUG_INFO
puts stderr "Errors saved to $logfile"
exit 1
}
::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]]
set filename [my define get output_c]
if {$filename eq {}} {
::practcl::debug [list /[self] [self method] [self class]]
return
}
set cout [open [file join $path [file rootname $filename].c] w]
puts $cout [subst {/*
** This file is generated by the [info script] script
** any changes will be overwritten the next time it is run
*/}]
puts $cout [my generate-c]
puts $cout [my generate-loader]
close $cout
::practcl::debug [list /[self] [self method] [self class]]
}
method linktype {} {
return {subordinate product dynamic module}
}
}
|