1#!/bin/sh 2# hack to restart using tclsh \ 3exec tclsh "$0" "$@" 4 5# Copyright (C) 1999, 2000 Aladdin Enterprises. All rights reserved. 6# 7# This program is free software; you can redistribute it and/or modify it 8# under the terms of the GNU General Public License as published by the 9# Free Software Foundation; either version 2 of the License, or (at your 10# option) any later version. 11# 12# This program is distributed in the hope that it will be useful, but 13# WITHOUT ANY WARRANTY; without even the implied warranty of 14# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General 15# Public License for more details. 16# 17# You should have received a copy of the GNU General Public License along 18# with this program; if not, write to the Free Software Foundation, Inc., 19# 59 Temple Place, Suite 330, Boston, MA, 02111-1307. 20 21# $Id: tmake.tcl,v 1.3.6.1.2.1 2003/04/12 14:02:39 giles Exp $ 22 23# This file is intended to be a drop-in replacement for a large and 24# useful subset of 'make'. It compiles makefiles into Tcl scripts 25# (lazily) and then executes the scripts. It requires makefiles to be 26# well-behaved: 27# 28# - If a rule body modifies a file, then either that file is a 29# target of the rule, or the file is not a target or dependent 30# of any rule. 31# 32# - If a rule body reads a file, then either that file is a 33# dependent of the rule, or the file is not a target of any rule. 34# 35# - No target is the target of more than one rule. 36 37# Define the backward-compatibility version of this file. 38set TMAKE_VERSION 104 39 40#****** -j doesn't work yet ******# 41 42# The following variables are recognized when the script is executed: 43# DEBUG - print a debugging trace 44# DRYRUN - just print commands, don't execute them 45# IGNORE_ERRORS - ignore errors in rule bodies 46# KEEP_GOING - continue past errors, but don't build anything affected 47# MAKEFLAGS - flags for recursive invocations 48# MAX_JOBS - maximum number of concurrent rule executions 49# MAX_LOAD - maximum load for parallel execution 50# SILENT - don't print commands 51# WARN_REDEFINED - warn about redefined variables 52# WARN_MULTIPLE - warn about variables defined more than once, 53# even if the definitions are identical 54# WARN_UNDEFINED - warn about undefined variables 55 56set FLAGS [list\ 57 DEBUG DRYRUN IGNORE_ERRORS KEEP_GOING SILENT\ 58 WARN_MULTIPLE WARN_REDEFINED WARN_UNDEFINED\ 59] 60set GLOBALS "$FLAGS\ 61 MAKEFLAGS MAX_JOBS MAX_LOAD\ 62" 63proc init_globals {} { 64 global FLAGS GLOBALS 65 66 foreach v $GLOBALS {global $v} 67 foreach v $FLAGS {set $v 0} 68 set MAKEFLAGS "" 69 set MAX_JOBS 1 70 set MAX_LOAD 99999 71} 72 73# ================ Runtime support ================ # 74 75# Patch in case we're running a pre-8.0 tcl. 76if {[info command clock] == ""} { 77 proc clock {ignore} {exec date +%s} 78} 79 80# Replace the following on systems that don't have /proc 81# (don't ask me how!). 82proc proc_loadavg {} { 83 set fid [open /dev/proc] 84 set load [lindex [read $fid] 0] 85 close $fid 86 return $load 87} 88proc proc_exists {pid} { 89 return [file exists /proc/$pid] 90} 91 92proc init_runtime {} { 93 global DEBUG I 94 95 set I 0 96 if {$DEBUG} { 97 proc ifdebug {script} {uplevel $script} 98 } { 99 proc ifdebug {script} {} 100 } 101 V MAKELEVEL 0 implicit 102} 103 104rename unknown old_unknown 105proc unknown_ {var} { 106 global WARN_UNDEFINED 107 108 if {$WARN_UNDEFINED} { 109 puts "*** Warning: $var is not defined" 110 } 111 V $var "" default 112 return 1 113} 114proc unknown@ {var} { 115 if {[catch {tset $var [file mtime $var]}]} { 116 global N TARGET_FAILED 117 118 set tlist "$var" 119 set i -1 120 puts "*** No rule to make target $var" 121 catch {while {1} { 122 set cmd [info level $i] 123 if {[lindex $cmd 0] == "target"} { 124 set t [lindex $cmd 1] 125 if {[info exists N($t)]} { 126 set at "$N($t):" 127 } { 128 set at "" 129 } 130 puts "\trequired by ${at}$t" 131 } 132 incr i -1 133 }} 134 puts "*** Can't continue." 135 set TARGET_FAILED $var 136 return -errorcode error 137 } 138 return 1 139} 140proc unknown {cmd args} { 141 if {[regexp {^([_@])(.*)$} $cmd skip 1st var]} { 142 if {$args == "" && [unknown$1st $var]} {return [$cmd]} 143 } 144 eval old_unknown [concat [list $cmd] $args] 145} 146proc var_value {var} { 147 # Skip over the "return" 148 set value [info body _$var] 149 if {[regexp "^proc _$var {} \\\[list return (.*)\\\];" $value skip value]} { 150 } else { 151 regexp {^return (.*)$} $value skip value 152 } 153 return $value 154} 155proc redefined {var value lnum} { 156 global WARN_MULTIPLE WARN_REDEFINED 157 158 if {$WARN_MULTIPLE || ($WARN_REDEFINED && $value != [var_value $var])} { 159 global _ 160 161 set old_lnum $_($var) 162 if {!(($old_lnum == "default" || $old_lnum == "implicit") && $lnum == "command-line")} { 163 set old_value [var_value $var] 164 puts "*** Warning: $var redefined from $old_value ($old_lnum) to $value ($lnum)" 165 } 166 } 167} 168proc V {var value lnum} { 169 global _ 170 171 if {![info exists _($var)]} { 172 ifdebug {puts "$var=$value"} 173 set _($var) $lnum 174 proc _$var {} [list return $value] 175 } elseif {[set old $_($var)] == "default"} { 176 unset _($var) 177 V $var $value $lnum 178 } elseif {$old != "command-line"} { 179 redefined $var $value $lnum 180 unset _($var) 181 V $var $value $lnum 182 } 183} 184proc P {var vexpr lnum} { 185 global _ 186 187 if {![info exists _($var)]} { 188 ifdebug {puts "$var=$vexpr"} 189 set _($var) $lnum 190 proc _$var {} "proc _$var {} \[list return $vexpr\];_$var" 191 } elseif {[set old $_($var)] == "default"} { 192 unset _($var) 193 P $var $vexpr $lnum 194 } elseif {$old != "command-line"} { 195 redefined $var $vexpr $lnum 196 unset _($var) 197 P $var $vexpr $lnum 198 } 199} 200 201# Record the very first target as the default target. 202proc R {tl dl body lnum} { 203 global TARGETS 204 205 if {$TARGETS == ""} { 206 lappend TARGETS [lindex $tl 0] 207 } 208 proc R {tl dl body lnum} { 209 global C I N T 210 211 set C([incr I]) $body 212 foreach t [set T($I) $tl] { 213 set N($t) $lnum 214 proc @$t {} [list target $t $dl $I] 215 } 216 } 217 R $tl $dl $body $lnum 218} 219proc tset {p t} { 220 proc @$p {} [list return $t] 221 ifdebug {puts "ftime($p) <- $t"} 222} 223proc reap_jobs {} { 224 global JOBS 225 226 set jobs {} 227 foreach j $JOBS { 228 if {[proc_exists [lindex $j 0]]} { 229 lappend jobs $j 230 } 231 } 232 set JOBS $jobs 233} 234proc shell_exec {cmds} { 235 global JOBS MAX_JOBS MAX_LOAD 236 237 set args [list sh -c - $cmds <@ stdin >@ stdout 2>@ stderr] 238 if {$MAX_JOBS <= 1} { 239 return [eval exec $args] 240 } 241 while {[llength $JOBS] > 0 && 242 ([llength $JOBS] > $MAX_JOBS || [proc_loadavg] >= $MAX_LOAD)} { 243 # There doesn't seem to be any standard way of either yielding 244 # the CPU, or sleeping for less than 1 second.... 245 reap_jobs 246 } 247 lappend JOBS [eval exec $args &] 248} 249proc rexec {i} { 250 global C T DRYRUN IGNORE_ERRORS SILENT 251 252 set cmds [eval $C($i)] 253 set ok 1 254 if {$DRYRUN} { 255 foreach c $cmds { 256 if {!$SILENT || ![regexp {^@} $c]} {puts $c} 257 } 258 flush stdout 259 } else { 260 set status 0 261 foreach c $cmds { 262 if {!([regsub {^@} $c "" c] || $SILENT)} {puts $c} 263 set ignore [regsub {^-} $c "" c] 264 if {![regexp {[][(){}*?!$|;&<>'"\=]} $c]} { 265 # We could execute these more efficiently, if we knew how 266 # to resolve the command name! 267 set status [catch {shell_exec $c}] 268 } else { 269 set status [catch {shell_exec $c}] 270 } 271 if {$status != 0 && !($ignore || $IGNORE_ERRORS)} {break} 272 } 273 flush stdout 274 if {$status} { 275 global errorCode IGNORE_ERRORS KEEP_GOING 276 277 set info $errorCode 278 set level [_MAKELEVEL] 279 if {$level == 0} {set level ""} {set level "\[$level\]"} 280 set code 255 281 catch { 282 if {[lindex $info 0] == "CHILDSTATUS"} { 283 set code [lindex $info 2] 284 } 285 } 286 puts "tmake$level: *** \[$T($i)\] Error $code" 287 if {!$IGNORE_ERRORS} { 288 if {!$KEEP_GOING} {exit $code} 289 set ok 0 290 } 291 } 292 } 293 # Set the last mod time of dummy targets to -infinity, so that they 294 # won't force their dependents to rebuild. 295 foreach t $T($i) { 296 if {[file exists $t]} { 297 tset $t [file mtime $t] 298 } { 299 tset $t -0x80000000 300 } 301 } 302 return $ok 303} 304proc target {t dl i} { 305 if {[catch {set mt [file mtime $t]}]} { 306 ifdebug {puts "no ttime($t)"} 307 foreach d $dl {@$d} 308 rexec $i 309 return [@$t] 310 } 311 ifdebug {puts "ttime($t)=$mt"} 312 set do 0 313 # The 'functional' interpretation of dependency would allow us 314 # to stop as soon as we reach the first dependent that is newer 315 # than the target, but all 'make' programs build all dependents, 316 # and some 'operational' rules depend on this. 317 foreach d $dl { 318 # For safety, the following test should be a >= rather than a >, 319 # but this causes excessive unnecessary rebuilding because of 320 # rules whose bodies take <1 second to execute. 321 if {[@$d] > $mt} { 322 ifdebug {puts "time($d)=[@$d] > ttime($t)=$mt"} 323 set do 1 324 } 325 } 326 if {$do} {rexec $i; return [@$t]} 327 tset $t $mt 328 ifdebug {puts "OK: $t"} 329 return $mt 330} 331 332proc _MAKEFLAGS {} { 333 global MAKEFLAGS 334 335 set flags $MAKEFLAGS 336 if {[regexp {^[^-]} $flags]} {set flags "-$flags"} 337 V MAKEFLAGS $flags implicit 338 return $flags 339} 340proc _MAKELEVEL_1 {} { 341 V MAKELEVEL_1 [set level1 [expr [_MAKELEVEL] + 1]] implicit 342 return $level1 343} 344proc tcompile {fname version} { 345 global TMAKE_TIME 346 347 set mf $fname 348 while {![catch {set mf [file readlink $mf]}]} {} 349 set tf ${mf}.tcl 350 if {![file exists $tf] || [file mtime $tf] < [file mtime $mf] || [file mtime $tf] < $TMAKE_TIME} { 351 puts "Compiling $mf to $tf." 352 flush stdout 353 mak2tcl $mf $tf 354 } 355 return $tf 356} 357proc tsource {fname {version 0}} { 358 set tf [tcompile $fname $version] 359 uplevel [list source $tf] 360} 361 362# ================ Compilation ================ # 363 364# 'Compile' a makefile to a Tcl script. 365# Each macro becomes a Tcl procedure prefixed by _. 366# This is so we can use Tcl's 'unknown' facility to default macro values 367# to the empty string, since Tcl doesn't appear to provide a way to trap 368# references to undefined variables. 369# Each target or precondition becomes a Tcl procedure prefixed by @. 370 371# ---------------- Utilities ---------------- # 372 373# Convert variable references from $(vname) to [_vname], 374# escape characters that need to be quoted within "", 375# and surround the result with "". 376proc quote {defn {refsvar ""}} { 377 set orig $defn 378 set fixed "" 379 set refs {} 380 while {[regexp {^(([^$]|\$[^$(])*)\$(\$|\(([^)]*)\))(.*)$} $orig skip pre skip2 dollar var orig]} { 381 regsub -all {([][\"$])} $pre {\\\1} pre 382 if {$dollar == "\$"} { 383 append fixed "$pre\\\$" 384 } else { 385 append fixed "$pre\[_$var\]" 386 } 387 lappend refs $var 388 } 389 regsub -all {([][\"$])} $orig {\\\1} orig 390 append fixed $orig 391 if {[string match {*[ \\]*} $fixed] || $fixed == ""} { 392 return "\"$fixed\"" 393 } 394 if {$refsvar != ""} { 395 upvar $refsvar rv 396 set rv $refs 397 } 398 return $fixed 399} 400 401# ---------------- Writing ---------------- # 402 403# Write the boilerplate at the beginning of the converted file. 404proc write_header {out fname} { 405 global TMAKE_VERSION 406 407 puts $out {#!/bin/tcl} 408 puts $out "# File $fname created [exec date] by tmake ${TMAKE_VERSION}." 409} 410 411# Write the definition of a macro. 412proc write_macro {out var defn linenum} { 413 puts $out "P $var {[quote $defn]} [list $linenum]" 414} 415 416# Write an 'include'. 417proc write_include {out fname} { 418 global TMAKE_VERSION 419 420 puts $out "tsource [quote $fname] $TMAKE_VERSION" 421} 422 423# Write a rule. 424proc write_rule {out targets deps commands linenum} { 425 # Convert all uses of 'make' or $(MAKE) in rule bodies to tmake. 426 set body list 427 foreach c $commands { 428 regsub {^(make|\$\(MAKE\)) } $c {tmake $(MAKEFLAGS) MAKELEVEL=$(MAKELEVEL_1) } c 429 append body " [quote $c]" 430 } 431 puts $out "R [quote $targets] [quote [string trim $deps]] [list $body] [list $linenum]" 432} 433 434# ---------------- Top level ---------------- # 435 436proc lgets {in lvar lnvar} { 437 upvar $lvar line $lnvar linenum 438 set line "" 439 set len [gets $in line] 440 if {$len < 0} {return $len} 441 incr linenum 442 while {[regsub {\\$} $line {} line]} { 443 if {[gets $in l] < 0} {break} 444 incr linenum 445 append line $l 446 } 447 return [string length $line] 448} 449 450proc mak2tcl {inname {outname ""}} { 451 global = 452 453 catch {unset =} 454 set in [open $inname] 455 if {$outname == ""} { 456 set out stdout 457 } { 458 set out [open $outname w] 459 } 460 write_header $out $outname 461 set linenum 1 462 for {set lnfirst $linenum} {[lgets $in line linenum] >= 0} {set lnfirst $linenum} { 463 if {$line == ""} {continue} 464 if {[string index $line 0] == "#"} {continue} 465 if {[regexp {^([0-9A-Za-z_]+)[ ]*=[ ]*(.*)[ ]*$} $line skip var defn]} { 466 write_macro $out $var $defn ${inname}:$lnfirst 467 continue 468 } 469 if {[regexp {^([^:]+):(.*)$} $line skip targets deps]} { 470 set commands {} 471 while {[lgets $in line linenum] > 0} { 472 regsub {^[ ]} $line {} line 473 lappend commands $line 474 } 475 write_rule $out $targets $deps $commands ${inname}:$lnfirst 476 continue 477 } 478 if {[regexp {^(!|)include[ ]+("|)([^ "]*)("|)$} $line skip skip2 skip3 fname]} { 479 write_include $out $fname 480 continue 481 } 482 # Recognize some GNU constructs 483 if {[regexp {^unexport } $line]} {continue} 484 puts "****Not recognized: $line" 485 } 486 if {$out != "stdout"} { 487 close $out 488 } 489 close $in 490} 491 492# ================ Command line processing ================ # 493 494proc tmake_args {args} { 495 global GLOBALS COMPILE DEFINES JOBS MAKEFILE TARGETS 496 497 foreach v $GLOBALS {global $v} 498 set argv $args 499 while {[llength $argv] > 0} { 500 set n 0 501 set copy 1 502 set arg [lindex $argv 0] 503 switch -glob -- $arg { 504 # -C is not implemented; set copy 0 505 --compile-only {set COMPILE 1} 506 -d {set DEBUG 1} 507 -f {set MAKEFILE [lindex $argv 1]; set n 1; set copy 0} 508 -i {set IGNORE_ERRORS 1} 509 -j { 510 if {[llength $argv] > 1 && [regexp {^[0-9]+$} [lindex $argv 1]]} { 511 set MAX_JOBS [lindex $argv 1]; set n 1 512 } else { 513 set MAX_JOBS 99999 514 } 515 } 516 -k {set KEEP_GOING 1} 517 -l {set MAX_LOAD [lindex $argv 1]; set n 1} 518 # -m is ignored for compatibility with GNU make; 519 # also, because MAKEFLAGS omits the initial '-', we need a 520 # dummy switch in case there are variable definitions (!). 521 -m {set copy 0} 522 -n {set DRYRUN 1} 523 -s {set SILENT 1} 524 --warn-multiply-defined-variables {set WARN_MULTIPLE 1} 525 --warn-redefined-variables {set WARN_REDEFINED 1} 526 --warn-undefined-variables {set WARN_UNDEFINED 1} 527 -* { 528 puts "Unknown option: $arg" 529 puts {Usage: tmake (<option> | <var>=<value> | <target>)*} 530 puts {Options:} 531 puts { --compile-only -d -i -k -n -s} 532 puts { --warn-multiply-defined-variables --warn-redefined-variables} 533 puts { --warn-undefined-variables} 534 puts { -f <file> -j <jobs> -l <load>} 535 exit 536 } 537 *=* { 538 regexp {^([^=]*)=(.*)$} $arg skip lhs rhs 539 lappend DEFINES [list $lhs $rhs] 540 set copy 0 541 } 542 default { 543 lappend TARGETS $arg 544 set copy 0 545 } 546 } 547 if $copy {lappend MAKEFLAGS [lrange $argv 0 $n]} 548 set argv [lreplace $argv 0 $n] 549 } 550} 551proc tmake {args} { 552 global argv0 553 global GLOBALS COMPILE DEFINES JOBS MAKEFILE TARGETS 554 global TMAKE_TIME TMAKE_VERSION 555 556 set TMAKE_TIME [file mtime $argv0] 557 foreach v $GLOBALS {global $v} 558 init_globals 559 set MAKEFILE makefile 560 set TARGETS "" 561 set DEFINES [list] 562 set COMPILE 0 563 set JOBS {} 564 eval tmake_args $args 565 # POSIX requires the following nonsense: 566 regsub {^-([^-])} $MAKEFLAGS {\1} MAKEFLAGS 567 if {$MAKEFLAGS == ""} {set MAKEFLAGS m} 568 foreach d $DEFINES { 569 append MAKEFLAGS " [lindex $d 0]='[lindex $d 1]'" 570 } 571 init_runtime 572 foreach d $DEFINES { 573 catch {unset _[lindex $d 0]} 574 V [lindex $d 0] [lindex $d 1] command-line 575 set _($d) 1 576 } 577 if {$COMPILE} { 578 # Just compile the given makefile(s). 579 tcompile $MAKEFILE $TMAKE_VERSION 580 } { 581 # Build the selected targets. 582 tsource $MAKEFILE $TMAKE_VERSION 583 foreach t $TARGETS { 584 global errorInfo TARGET_FAILED 585 586 set TARGET_FAILED "" 587 set status [catch "@$t" result] 588 if {$status == 0} {continue} 589 if {$status == 1 && $TARGET_FAILED != ""} { 590 exit 1 591 } 592 puts stderr $errorInfo 593 exit $status 594 } 595 } 596} 597 598eval tmake $argv 599