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