1### 2# A deliverable for the build system 3### 4::clay::define ::practcl::product { 5 6 method code {section body} { 7 my variable code 8 ::practcl::cputs code($section) $body 9 } 10 11 method Collate_Source CWD {} 12 13 method project-compile-products {} { 14 set result {} 15 noop { 16 set filename [my define get filename] 17 if {$filename ne {}} { 18 ::practcl::debug [self] [self class] [self method] project-compile-products $filename 19 if {[my define exists ofile]} { 20 set ofile [my define get ofile] 21 } else { 22 set ofile [my Ofile $filename] 23 my define set ofile $ofile 24 } 25 lappend result $ofile [list cfile $filename include [my define get include] extra [my define get extra] external [string is true -strict [my define get external]] object [self]] 26 } 27 } 28 foreach item [my link list subordinate] { 29 lappend result {*}[$item project-compile-products] 30 } 31 return $result 32 } 33 34 method generate-debug {{spaces {}}} { 35 set result {} 36 ::practcl::cputs result "$spaces[list [self] [list class [info object class [self]] filename [my define get filename]] links [my link list]]" 37 foreach item [my link list subordinate] { 38 practcl::cputs result [$item generate-debug "$spaces "] 39 } 40 return $result 41 } 42 43 method generate-cfile-constant {} { 44 ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] 45 set result {} 46 my variable code cstruct methods tcltype 47 if {[info exists code(constant)]} { 48 ::practcl::cputs result "/* [my define get filename] CONSTANT */" 49 ::practcl::cputs result $code(constant) 50 } 51 foreach obj [my link list product] { 52 # Exclude products that will generate their own C files 53 if {[$obj define get output_c] ne {}} continue 54 ::practcl::cputs result [$obj generate-cfile-constant] 55 } 56 return $result 57 } 58 59 ### 60 # Populate const static data structures 61 ### 62 method generate-cfile-public-structure {} { 63 ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] 64 my variable code cstruct methods tcltype 65 set result {} 66 if {[info exists code(struct)]} { 67 ::practcl::cputs result $code(struct) 68 } 69 foreach obj [my link list product] { 70 # Exclude products that will generate their own C files 71 if {[$obj define get output_c] ne {}} continue 72 ::practcl::cputs result [$obj generate-cfile-public-structure] 73 } 74 return $result 75 } 76 77 method generate-cfile-header {} { 78 ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] 79 my variable code cfunct cstruct methods tcltype tclprocs 80 set result {} 81 if {[info exists code(header)]} { 82 ::practcl::cputs result $code(header) 83 } 84 foreach obj [my link list product] { 85 # Exclude products that will generate their own C files 86 if {[$obj define get output_c] ne {}} continue 87 set dat [$obj generate-cfile-header] 88 if {[string length [string trim $dat]]} { 89 ::practcl::cputs result "/* BEGIN [$obj define get filename] generate-cfile-header */" 90 ::practcl::cputs result $dat 91 ::practcl::cputs result "/* END [$obj define get filename] generate-cfile-header */" 92 } 93 } 94 return $result 95 } 96 97 method generate-cfile-global {} { 98 ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] 99 my variable code cfunct cstruct methods tcltype tclprocs 100 set result {} 101 if {[info exists code(global)]} { 102 ::practcl::cputs result $code(global) 103 } 104 foreach obj [my link list product] { 105 # Exclude products that will generate their own C files 106 if {[$obj define get output_c] ne {}} continue 107 set dat [$obj generate-cfile-global] 108 if {[string length [string trim $dat]]} { 109 ::practcl::cputs result "/* BEGIN [$obj define get filename] generate-cfile-global */" 110 ::practcl::cputs result $dat 111 ::practcl::cputs result "/* END [$obj define get filename] generate-cfile-global */" 112 } 113 } 114 return $result 115 } 116 117 method generate-cfile-private-typedef {} { 118 ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] 119 my variable code cstruct 120 set result {} 121 if {[info exists code(private-typedef)]} { 122 ::practcl::cputs result $code(private-typedef) 123 } 124 if {[info exists cstruct]} { 125 # Add defintion for native c data structures 126 foreach {name info} $cstruct { 127 if {[dict get $info public]==1} continue 128 ::practcl::cputs result "typedef struct $name ${name}\;" 129 if {[dict exists $info aliases]} { 130 foreach n [dict get $info aliases] { 131 ::practcl::cputs result "typedef struct $name ${n}\;" 132 } 133 } 134 } 135 } 136 set result [::practcl::_tagblock $result c [my define get filename]] 137 foreach mod [my link list product] { 138 ::practcl::cputs result [$mod generate-cfile-private-typedef] 139 } 140 return $result 141 } 142 143 method generate-cfile-private-structure {} { 144 ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] 145 my variable code cstruct 146 set result {} 147 if {[info exists code(private-structure)]} { 148 ::practcl::cputs result $code(private-structure) 149 } 150 if {[info exists cstruct]} { 151 foreach {name info} $cstruct { 152 if {[dict get $info public]==1} continue 153 if {[dict exists $info comment]} { 154 ::practcl::cputs result [dict get $info comment] 155 } 156 ::practcl::cputs result "struct $name \{[dict get $info body]\}\;" 157 } 158 } 159 set result [::practcl::_tagblock $result c [my define get filename]] 160 foreach mod [my link list product] { 161 ::practcl::cputs result [$mod generate-cfile-private-structure] 162 } 163 return $result 164 } 165 166 167 ### 168 # Generate code that provides subroutines called by 169 # Tcl API methods 170 ### 171 method generate-cfile-functions {} { 172 ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] 173 my variable code cfunct 174 set result {} 175 if {[info exists code(funct)]} { 176 ::practcl::cputs result $code(funct) 177 } 178 if {[info exists cfunct]} { 179 foreach {funcname info} $cfunct { 180 ::practcl::cputs result "/* $funcname */" 181 if {[dict get $info inline] && [dict get $info public]} { 182 ::practcl::cputs result "\ninline [dict get $info header]\{[dict get $info body]\}" 183 } else { 184 ::practcl::cputs result "\n[dict get $info header]\{[dict get $info body]\}" 185 } 186 } 187 } 188 foreach obj [my link list product] { 189 # Exclude products that will generate their own C files 190 if {[$obj define get output_c] ne {}} { 191 continue 192 } 193 ::practcl::cputs result [$obj generate-cfile-functions] 194 } 195 return $result 196 } 197 198 ### 199 # Generate code that provides implements Tcl API 200 # calls 201 ### 202 method generate-cfile-tclapi {} { 203 ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] 204 my variable code methods tclprocs 205 set result {} 206 if {[info exists code(method)]} { 207 ::practcl::cputs result $code(method) 208 } 209 foreach obj [my link list product] { 210 # Exclude products that will generate their own C files 211 if {[$obj define get output_c] ne {}} continue 212 ::practcl::cputs result [$obj generate-cfile-tclapi] 213 } 214 return $result 215 } 216 217 218 method generate-hfile-public-define {} { 219 ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] 220 my variable code 221 set result {} 222 if {[info exists code(public-define)]} { 223 ::practcl::cputs result $code(public-define) 224 } 225 set result [::practcl::_tagblock $result c [my define get filename]] 226 foreach mod [my link list product] { 227 ::practcl::cputs result [$mod generate-hfile-public-define] 228 } 229 return $result 230 } 231 232 method generate-hfile-public-macro {} { 233 ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] 234 my variable code 235 set result {} 236 if {[info exists code(public-macro)]} { 237 ::practcl::cputs result $code(public-macro) 238 } 239 set result [::practcl::_tagblock $result c [my define get filename]] 240 foreach mod [my link list product] { 241 ::practcl::cputs result [$mod generate-hfile-public-macro] 242 } 243 return $result 244 } 245 246 method generate-hfile-public-typedef {} { 247 ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] 248 my variable code cstruct 249 set result {} 250 if {[info exists code(public-typedef)]} { 251 ::practcl::cputs result $code(public-typedef) 252 } 253 if {[info exists cstruct]} { 254 # Add defintion for native c data structures 255 foreach {name info} $cstruct { 256 if {[dict get $info public]==0} continue 257 ::practcl::cputs result "typedef struct $name ${name}\;" 258 if {[dict exists $info aliases]} { 259 foreach n [dict get $info aliases] { 260 ::practcl::cputs result "typedef struct $name ${n}\;" 261 } 262 } 263 } 264 } 265 set result [::practcl::_tagblock $result c [my define get filename]] 266 foreach mod [my link list product] { 267 ::practcl::cputs result [$mod generate-hfile-public-typedef] 268 } 269 return $result 270 } 271 272 method generate-hfile-public-structure {} { 273 ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] 274 my variable code cstruct 275 set result {} 276 if {[info exists code(public-structure)]} { 277 ::practcl::cputs result $code(public-structure) 278 } 279 if {[info exists cstruct]} { 280 foreach {name info} $cstruct { 281 if {[dict get $info public]==0} continue 282 if {[dict exists $info comment]} { 283 ::practcl::cputs result [dict get $info comment] 284 } 285 ::practcl::cputs result "struct $name \{[dict get $info body]\}\;" 286 } 287 } 288 set result [::practcl::_tagblock $result c [my define get filename]] 289 foreach mod [my link list product] { 290 ::practcl::cputs result [$mod generate-hfile-public-structure] 291 } 292 return $result 293 } 294 295 method generate-hfile-public-headers {} { 296 ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] 297 my variable code tcltype 298 set result {} 299 if {[info exists code(public-header)]} { 300 ::practcl::cputs result $code(public-header) 301 } 302 if {[info exists tcltype]} { 303 foreach {type info} $tcltype { 304 if {![dict exists $info cname]} { 305 set cname [string tolower ${type}]_tclobjtype 306 dict set tcltype $type cname $cname 307 } else { 308 set cname [dict get $info cname] 309 } 310 ::practcl::cputs result "extern const Tcl_ObjType $cname\;" 311 } 312 } 313 if {[info exists code(public)]} { 314 ::practcl::cputs result $code(public) 315 } 316 set result [::practcl::_tagblock $result c [my define get filename]] 317 foreach mod [my link list product] { 318 ::practcl::cputs result [$mod generate-hfile-public-headers] 319 } 320 return $result 321 } 322 323 method generate-hfile-public-function {} { 324 ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] 325 my variable code cfunct tcltype 326 set result {} 327 328 if {[my define get initfunc] ne {}} { 329 ::practcl::cputs result "int [my define get initfunc](Tcl_Interp *interp);" 330 } 331 if {[info exists cfunct]} { 332 foreach {funcname info} $cfunct { 333 if {![dict get $info public]} continue 334 ::practcl::cputs result "[dict get $info header]\;" 335 } 336 } 337 set result [::practcl::_tagblock $result c [my define get filename]] 338 foreach mod [my link list product] { 339 ::practcl::cputs result [$mod generate-hfile-public-function] 340 } 341 return $result 342 } 343 344 method generate-hfile-public-includes {} { 345 ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] 346 set includes {} 347 foreach item [my define get public-include] { 348 if {$item ni $includes} { 349 lappend includes $item 350 } 351 } 352 foreach mod [my link list product] { 353 foreach item [$mod generate-hfile-public-includes] { 354 if {$item ni $includes} { 355 lappend includes $item 356 } 357 } 358 } 359 return $includes 360 } 361 362 method generate-hfile-public-verbatim {} { 363 ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] 364 set includes {} 365 foreach item [my define get public-verbatim] { 366 if {$item ni $includes} { 367 lappend includes $item 368 } 369 } 370 foreach mod [my link list subordinate] { 371 foreach item [$mod generate-hfile-public-verbatim] { 372 if {$item ni $includes} { 373 lappend includes $item 374 } 375 } 376 } 377 return $includes 378 } 379 380 method generate-loader-external {} { 381 if {[my define get initfunc] eq {}} { 382 return "/* [my define get filename] declared not initfunc */" 383 } 384 return " if([my define get initfunc](interp)) return TCL_ERROR\;" 385 } 386 387 method generate-loader-module {} { 388 ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] 389 my variable code 390 set result {} 391 if {[info exists code(cinit)]} { 392 ::practcl::cputs result $code(cinit) 393 } 394 if {[my define get initfunc] ne {}} { 395 ::practcl::cputs result " if([my define get initfunc](interp)!=TCL_OK) return TCL_ERROR\;" 396 } 397 set result [::practcl::_tagblock $result c [my define get filename]] 398 foreach item [my link list product] { 399 if {[$item define get output_c] ne {}} { 400 ::practcl::cputs result [$item generate-loader-external] 401 } else { 402 ::practcl::cputs result [$item generate-loader-module] 403 } 404 } 405 return $result 406 } 407 408 method generate-stub-function {} { 409 ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] 410 my variable code cfunct tcltype 411 set result {} 412 foreach mod [my link list product] { 413 foreach {funct def} [$mod generate-stub-function] { 414 dict set result $funct $def 415 } 416 } 417 if {[info exists cfunct]} { 418 foreach {funcname info} $cfunct { 419 if {![dict get $info export]} continue 420 dict set result $funcname [dict get $info header] 421 } 422 } 423 return $result 424 } 425 426 427 method IncludeAdd {headervar args} { 428 upvar 1 $headervar headers 429 foreach inc $args { 430 if {[string index $inc 0] ni {< \"}} { 431 set inc "\"$inc\"" 432 } 433 if {$inc ni $headers} { 434 lappend headers $inc 435 } 436 } 437 } 438 439 method generate-tcl-loader {} { 440 set result {} 441 set PKGINIT [my define get pkginit] 442 set PKG_NAME [my define get name [my define get pkg_name]] 443 set PKG_VERSION [my define get pkg_vers [my define get version]] 444 if {[string is true [my define get SHARED_BUILD 0]]} { 445 set LIBFILE [my define get libfile] 446 ::practcl::cputs result [string map \ 447 [list @LIBFILE@ $LIBFILE @PKGINIT@ $PKGINIT @PKG_NAME@ $PKG_NAME @PKG_VERSION@ $PKG_VERSION] { 448# Shared Library Style 449load [file join [file dirname [file join [pwd] [info script]]] @LIBFILE@] @PKGINIT@ 450package provide @PKG_NAME@ @PKG_VERSION@ 451}] 452 } else { 453 ::practcl::cputs result [string map \ 454 [list @PKGINIT@ $PKGINIT @PKG_NAME@ $PKG_NAME @PKG_VERSION@ $PKG_VERSION] { 455# Tclkit Style 456load {} @PKGINIT@ 457package provide @PKG_NAME@ @PKG_VERSION@ 458}] 459 } 460 return $result 461 } 462 463 ### 464 # This methods generates any Tcl script file 465 # which is required to pre-initialize the C library 466 ### 467 method generate-tcl-pre {} { 468 ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] 469 set result {} 470 my variable code 471 if {[info exists code(tcl)]} { 472 set result [::practcl::_tagblock $code(tcl) tcl [my define get filename]] 473 } 474 if {[info exists code(tcl-pre)]} { 475 set result [::practcl::_tagblock $code(tcl) tcl [my define get filename]] 476 } 477 foreach mod [my link list product] { 478 ::practcl::cputs result [$mod generate-tcl-pre] 479 } 480 return $result 481 } 482 483 method generate-tcl-post {} { 484 ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] 485 set result {} 486 my variable code 487 if {[info exists code(tcl-post)]} { 488 set result [::practcl::_tagblock $code(tcl-post) tcl [my define get filename]] 489 } 490 foreach mod [my link list product] { 491 ::practcl::cputs result [$mod generate-tcl-post] 492 } 493 return $result 494 } 495 496 497 method linktype {} { 498 return {subordinate product} 499 } 500 501 method Ofile filename { 502 set lpath [my <module> define get localpath] 503 if {$lpath eq {}} { 504 set lpath [my <module> define get name] 505 } 506 return ${lpath}_[file rootname [file tail $filename]] 507 } 508 509 ### 510 # Methods called by the master project 511 ### 512 513 method project-static-packages {} { 514 set result [my define get static_packages] 515 set initfunc [my define get initfunc] 516 if {$initfunc ne {}} { 517 set pkg_name [my define get pkg_name] 518 if {$pkg_name ne {}} { 519 dict set result $pkg_name initfunc $initfunc 520 dict set result $pkg_name version [my define get version [my define get pkg_vers]] 521 dict set result $pkg_name autoload [my define get autoload 0] 522 } 523 } 524 foreach item [my link list subordinate] { 525 foreach {pkg info} [$item project-static-packages] { 526 dict set result $pkg $info 527 } 528 } 529 return $result 530 } 531 532 ### 533 # Methods called by the toolset 534 ### 535 536 method toolset-include-directory {} { 537 ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] 538 set result [my define get include_dir] 539 foreach obj [my link list product] { 540 foreach path [$obj toolset-include-directory] { 541 lappend result $path 542 } 543 } 544 return $result 545 } 546 547 method target {method args} { 548 switch $method { 549 is_unix { return [expr {$::tcl_platform(platform) eq "unix"}] } 550 } 551 } 552} 553oo::objdefine ::practcl::product { 554 555 method select {object} { 556 set class [$object define get class] 557 set mixin [$object define get product] 558 if {$class eq {} && $mixin eq {}} { 559 set filename [$object define get filename] 560 if {$filename ne {} && [file exists $filename]} { 561 switch [file extension $filename] { 562 .tcl { 563 set mixin ::practcl::product.dynamic 564 } 565 .h { 566 set mixin ::practcl::product.cheader 567 } 568 .c { 569 set mixin ::practcl::product.csource 570 } 571 .ini { 572 switch [file tail $filename] { 573 module.ini { 574 set class ::practcl::module 575 } 576 library.ini { 577 set class ::practcl::subproject 578 } 579 } 580 } 581 .so - 582 .dll - 583 .dylib - 584 .a { 585 set mixin ::practcl::product.clibrary 586 } 587 } 588 } 589 } 590 if {$class ne {}} { 591 $object clay mixinmap core $class 592 } 593 if {$mixin ne {}} { 594 $object clay mixinmap product $mixin 595 } 596 } 597} 598 599### 600# A product which generated from a C header file. Which is to say, nothing. 601### 602::clay::define ::practcl::product.cheader { 603 superclass ::practcl::product 604 605 method project-compile-products {} {} 606 method generate-loader-module {} {} 607} 608 609### 610# A product which generated from a C source file. Normally an object (.o) file. 611### 612::clay::define ::practcl::product.csource { 613 superclass ::practcl::product 614 615 method project-compile-products {} { 616 set result {} 617 set filename [my define get filename] 618 if {$filename ne {}} { 619 ::practcl::debug [self] [self class] [self method] project-compile-products $filename 620 if {[my define exists ofile]} { 621 set ofile [my define get ofile] 622 } else { 623 set ofile [my Ofile $filename] 624 my define set ofile $ofile 625 } 626 lappend result $ofile [list cfile $filename extra [my define get extra] external [string is true -strict [my define get external]] object [self]] 627 } 628 foreach item [my link list subordinate] { 629 lappend result {*}[$item project-compile-products] 630 } 631 return $result 632 } 633} 634 635### 636# A product which is generated from a compiled C library. 637# Usually a .a or a .dylib file, but in complex cases may 638# actually just be a conduit for one project to integrate the 639# source code of another 640### 641::clay::define ::practcl::product.clibrary { 642 superclass ::practcl::product 643 644 method linker-products {configdict} { 645 return [my define get filename] 646 } 647 648} 649 650### 651# A product which is generated from C code that itself is generated 652# by practcl or some other means. This C file may or may not produce 653# its own .o file, depending on whether it is eligible to become part 654# of an amalgamation 655### 656::clay::define ::practcl::product.dynamic { 657 superclass ::practcl::dynamic ::practcl::product 658 659 method initialize {} { 660 set filename [my define get filename] 661 if {$filename eq {}} { 662 return 663 } 664 if {[my define get name] eq {}} { 665 my define set name [file tail [file rootname $filename]] 666 } 667 if {[my define get localpath] eq {}} { 668 my define set localpath [my <module> define get localpath]_[my define get name] 669 } 670 # Future Development: 671 # Scan source file to see if it is encoded in criticl or practcl notation 672 #set thisline {} 673 #foreach line [split [::practcl::cat $filename] \n] { 674 # 675 #} 676 ::source $filename 677 if {[my define get output_c] ne {}} { 678 # Turn into a module if we have an output_c file 679 my morph ::practcl::module 680 } 681 } 682} 683 684### 685# A binary product produced by critcl. Note: The implementation is not 686# written yet, this class does nothing. 687::clay::define ::practcl::product.critcl { 688 superclass ::practcl::dynamic ::practcl::product 689} 690 691