1#!/usr/bin/tclsh 2 3# Copyright (C) 1996, 2000 Aladdin Enterprises. All rights reserved. 4# 5# This program is free software; you can redistribute it and/or modify it 6# under the terms of the GNU General Public License as published by the 7# Free Software Foundation; either version 2 of the License, or (at your 8# option) any later version. 9# 10# This program is distributed in the hope that it will be useful, but 11# WITHOUT ANY WARRANTY; without even the implied warranty of 12# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General 13# Public License for more details. 14# 15# You should have received a copy of the GNU General Public License along 16# with this program; if not, write to the Free Software Foundation, Inc., 17# 59 Temple Place, Suite 330, Boston, MA, 02111-1307. 18 19# $Id: gsmake.tcl,v 1.5.6.1.2.1 2003/04/12 14:02:39 giles Exp $ 20 21# gsmake.tcl - Tcl tools for Aladdin's products. Eventually we hope to: 22# Generate automatically: 23# For compiling and linking: 24# most of lib.mak, int.mak, and devs.mak 25# (_h defs, most .$(OBJ) rules, most .dev rules) 26# most of devs.mak 27# For fonts: 28# cfonts.mak 29# ccfonts option 30# The tools in this file can currently: 31# Check the makefiles for consistency with the #include lists 32# in .c/.cpp and .h files. 33# Check the makefiles for consistency with the devices defined 34# in .c/.cpp files. 35 36# Define a set of dependencies that we know about and don't consider 37# "unknown". 38set KNOWN_DEPS(cc.tr) 1 39set KNOWN_DEPS(echogs) 1 40 41# ---------------- Environment-specific procedures ---------------- # 42 43# Return a list of the exported and imported symbols of an object module. 44proc obj_symbols {objfile} { 45 set export {} 46 set import {} 47 foreach line [split [exec nm -gp $objfile] "\n"] { 48 if {[regexp {([A-Z]) ([^ ]+)$} [string trim $line] skip type sym]} { 49 if {$type == "U"} { 50 lappend import $sym 51 } else { 52 lappend export $sym 53 } 54 } 55 } 56 return [list $export $import] 57} 58 59# ---------------- Reading makefiles ---------------- # 60 61# The following procedures parse makefiles by reading them into an array 62# with the following components: 63# * files - a list of all the makefiles read in 64# * names - a list of all the defined names, in appearance order, 65# in the form macro= or target: 66# * pos:M= - the file and position of the definition of macro M 67# * pos:T: - the file and position of the rule for T 68# defn:M - definition of macro M 69# deps:T - dependencies for target T 70# body:T - rule body for T, a list of lines 71# File names in members marked with a * are normalized (see normalize_fname 72# below, as are target names (T); note that file names in dependencies 73# (value of deps:T) are not. 74 75# Global variables used: CWD 76 77# Initialize the tables. 78proc makefile_init {mfarray} { 79 catch {uplevel 1 [list unset $mfarray]} 80 upvar $mfarray mf 81 82 set mf(files) "" 83 set mf(names) "" 84} 85 86# Set CWD to the current working directory name (as a list). 87proc setcwd {} { 88 global CWD 89 90 set CWD [split [exec pwd] /] 91 if {[lindex $CWD 0] == ""} { 92 set CWD [lrange $CWD 1 end] 93 } 94} 95 96# Normalize a file name by removing all occurrences of ./, 97# all occurrences of <dir>/../, 98# and any occurrences of ../<dir>/ that are vacuous relative to CWD. 99proc normalize_fname {fname} { 100 global CWD 101 102 set name $fname 103 # Remove a trailing / 104 regsub {/$} $name "" name 105 # Remove occurrences of ./ 106 while {[regsub {^\./} $name "" name]} {} 107 while {[regsub {/\./} $name / name]} {} 108 while {[regsub {/\.$} $name "" name]} {} 109 if {$name == ""} {return /} 110 # Remove occurrences of <dir>/../ 111 while {[regsub {(^|/)([^./]|.[^./])[^/]*/../} $name {\1} name]} {} 112 # Now if any ../ are left, they are 113 # the first thing in the file name. 114 if {[regexp {^((../)+)(.*)$} $name skip up skip2 rest] && $rest != "" && $rest != ".."} { 115 set count [expr {[string length $up] / 3}] 116 if {$count <= [llength $CWD]} { 117 set tail [lrange $CWD [expr {[llength $CWD] - $count}] end] 118 while {$count > 0 && [regsub "^[lindex $tail 0]/" $rest "" rest]} { 119 set up [string range $up 3 end] 120 set tail [lrange $tail 1 end] 121 incr count -1 122 } 123 set name "$up$rest" 124 } 125 } 126 if {$name == ""} {return .} 127 return $name 128} 129 130# Find all the macro references in a string (macro, dependencies, or 131# rule body). 132proc macro_refs {line} { 133 regsub -all {[^$]*(\$\(([^)]+)\)|\$|$)} $line {\2 } refs 134 return [string trim $refs] 135} 136 137# Expand macro definitions in a string. 138# nosub decides whether a macro should (not) be expanded. 139# defer says what non-expanded macros should become. 140proc always_subst {var} { 141 return 0 142} 143proc macro_expand {mfarray str {nosub always_subst} {defer {$(\1)}}} { 144 upvar $mfarray mf 145 146 set in $str 147 set out "" 148 while {[regexp {^([^$]*)\$\(([^)]+)\)(.*)$} $in skip first var rest]} { 149 if {[uplevel 1 [concat $nosub $var]] || ![info exists mf(pos:$var=)]} { 150 regsub {^(.*)$} $var $defer var 151 append out "$first$var" 152 } else { 153 append out "$first[macro_expand mf $mf(defn:$var) $nosub $defer]" 154 } 155 set in $rest 156 } 157 return "$out$in" 158} 159 160# Check the references to macros in a definition or rule line. 161proc check_refs {mfarray line ref} { 162 upvar $mfarray mf 163 164 foreach var [macro_refs $line] { 165 if ![info exists mf(defn:$var)] { 166 puts "Warning: $ref refers to undefined macro $var" 167 set mf(defn:$var) "" 168 } 169 } 170} 171 172# Read a line from a makefile, recognizing a trailing \ for continuation. 173# source is an array with keys {file, lnum}. 174# Return -1 or the original value of source(lnum). 175proc linegets {sourcevar linevar} { 176 upvar $sourcevar source $linevar line 177 178 set infile $source(file) 179 if {[gets $infile line] < 0} {return -1} 180 set lnum $source(lnum) 181 incr source(lnum) 182 while {[regsub {\\$} $line {} line]} { 183 gets $infile l 184 append line $l 185 incr source(lnum) 186 } 187 return $lnum 188} 189 190# Read a makefile, adding to the tables. 191proc read_makefile {mfarray inname} { 192 global CWD 193 upvar $mfarray mf 194 195 setcwd 196 set inname [normalize_fname $inname] 197 set infile [open $inname] 198 lappend mf(files) $inname 199 set source(file) $infile 200 set source(lnum) 1 201 while {[set pos [linegets source line]] >= 0} { 202 if [regexp {^([A-Za-z_$][^=:]*)([=:])(.*)$} $line skip lhs eq rhs] { 203 define$eq mf $lhs $rhs $inname:$pos source 204 } elseif {[regsub {^(!|)include([ ]+)} $line {} file]} { 205 regsub -all {"} $file {} file 206 set file [macro_expand mf $file {string match {"}}] 207 read_makefile mf $file 208 } 209 } 210 close $infile 211} 212# Define a list (macro). 213proc define= {mfarray lhs rhs pos sourcevar} { 214 upvar $mfarray mf 215 216 set var [string trim [macro_expand mf $lhs]] 217 if [info exists mf(pos:$var=)] { 218 puts "Warning: $pos: macro $var redefined" 219 puts " $mf(pos:$var=): previous definition" 220 } 221 set mf(pos:$var=) $pos 222 set mf(defn:$var) $rhs 223 check_refs mf $rhs "$pos: Macro $var" 224 lappend mf(names) $var= 225} 226# Define a rule. 227proc define: {mfarray lhs rhs pos sourcevar} { 228 upvar $mfarray mf $sourcevar source 229 230 set targets "" 231 foreach target [macro_expand mf $lhs] { 232 lappend targets [normalize_fname $target] 233 } 234 set lines "" 235 while {[set lnum [linegets source line]] >= 0 && $line != ""} { 236 if ![regexp {^#} $line] { 237 regsub {[0-9]+$} $pos $lnum lpos 238 check_refs mf $line "$lpos: Rule for $targets" 239 lappend lines $line 240 } 241 } 242 foreach target $targets { 243 set mf(pos:$target:) $pos 244 set mf(deps:$target) $rhs 245 set mf(body:$target) $lines 246 lappend mf(names) $target: 247 } 248} 249 250# ---------------- Reading source code ---------------- # 251 252# Scan a list of .c, .cpp, or .h files and extract references that conform 253# to a particular syntax. We use egrep to find the lines containing 254# the references, and regexp to extract the referent. 255proc set_references {refarray files grepexp rexp} { 256 catch {uplevel 1 [list unset $refarray]} 257 upvar $refarray refs 258 259 switch [llength $files] { 260 0 {return} 261 1 { ;# force grep to output file name 262 close [open _.nul w] 263 lappend files _.nul 264 } 265 } 266 foreach f $files { 267 append refs($f) {} ;# ensure existence 268 } 269 set cmd [list exec -keepnewline grep -E $grepexp] 270 append cmd " $files >_.tmp" 271 if {![catch $cmd]} { 272 set in [open _.tmp] 273 set re {^([^:]*):} 274 append re $rexp 275 while {[gets $in line] > 0} { 276 regexp $re $line skip f i 277 lappend refs($f) $i 278 } 279 close $in 280 } 281} 282 283# Scan a list of .c, .cpp, or .h files and extract the "include" lists. 284# Set the array incarray to the (sorted) lists. 285proc set_includes {incarray files} { 286 upvar $incarray incs 287 288 set gre {^#[ ]*include[ ]+\"} 289 set re {#[\ \ ]*include[\ \ ]+"([^"]*)"} 290 set_references incs $files $gre $re 291 foreach f [array names incs] { 292 set incs($f) [lsort $incs($f)] 293 } 294} 295 296# Scan a list of .c or .cpp files and extract any devices they define. 297# Set the array devarray to the lists. 298proc set_devices {devarray files} { 299 upvar $devarray devs 300 301 set gre {gs_[0-9a-zA-Z]+_device.=} 302 set re {.*gs_([0-9a-zA-Z]+)_device.=} 303 set_references devs $files $gre $re 304} 305 306# ---------------- Checking makefiles ---------------- # 307 308# Expand a dependency list by substituting the values of all macro 309# references except _h macros. 310proc expand_deps {deps mfarray} { 311 upvar $mfarray mf 312 313 return [macro_expand mf $deps {regexp {_h$}}] 314} 315 316# Check the definition of one .h file. 317proc check_h {file incarray mfarray} { 318 global KNOWN_DEPS 319 upvar $incarray incs $mfarray mf 320 321 set base [file tail $file] 322 regsub {\.} $base {_} file_h 323 if ![info exists mf(defn:$file_h)] { 324 puts "$file exists, $file_h not defined" 325 } else { 326 set here { 327 puts "In definition of $file_h at $mf(pos:$file_h=):" 328 set here "" 329 } 330 foreach i $incs($file) { 331 set inc($i) 1 332 } 333 foreach d [expand_deps $mf(defn:$file_h) mf] { 334 if [regexp {^\$\((.*)_h\)$} $d skip b] { 335 set def($b.h) 1 336 } else { 337 set d [normalize_fname $d] 338 if {$d == $base || $d == $file} { 339 } elseif {[regexp {\.h$} $d]} { 340 set def($d) 1 341 } elseif {![info exists KNOWN_DEPS([file tail $d])]} { 342 eval $here 343 puts " Unknown element $d" 344 } 345 } 346 } 347 foreach i [array names inc] { 348 if ![info exists def($i)] { 349 eval $here 350 puts " $base includes $i, missing from definition" 351 } 352 } 353 foreach d [array names def] { 354 if ![info exists inc($d)] { 355 eval $here 356 puts " Definition references $d, not included by $base" 357 } 358 } 359 } 360} 361 362# Check the definition of one .c or .cpp file. 363proc check_c {file incarray mfarray} { 364 global KNOWN_DEPS 365 upvar $incarray incs $mfarray mf 366 367 set base [file tail $file] 368 regsub {\.(c|cpp)$} $file {.$(OBJ)} file_obj 369 set file_obj [macro_expand mf $file_obj] 370 if ![info exists mf(deps:$file_obj)] { 371 # Maybe the object files are in another directory. 372 set tail [file tail $file_obj] 373 set known [concat [array names mf deps:$tail]\ 374 [array names mf deps:*/$tail]] 375 switch [llength $known] { 376 0 { 377 puts "No rule for $file_obj" 378 return 379 } 380 1 { 381 regsub {^deps:} [lindex $known 0] {} file_obj 382 } 383 default { 384 puts "Ambiguous matches for $file_obj: $known" 385 return 386 } 387 } 388 } 389 set here { 390 puts "In rule for $file_obj at $mf(pos:$file_obj:):" 391 set here "" 392 } 393 foreach i $incs($file) { 394 set inc($i) 1 395 } 396 foreach d [expand_deps $mf(deps:$file_obj) mf] { 397 if [regexp {^\$\((.*)_h\)$} $d skip b] { 398 set def($b.h) 1 399 } else { 400 set d [normalize_fname $d] 401 if {$d == $base || $d == $file} { 402 } elseif {[regexp {\.h$} $d]} { 403 set def($d) 1 404 } elseif {![info exists KNOWN_DEPS([file tail $d])]} { 405 eval $here 406 puts " Unknown element $d" 407 } 408 } 409 } 410 foreach i [array names inc] { 411 if ![info exists def($i)] { 412 eval $here 413 puts " $base includes $i, missing from dependencies" 414 } 415 } 416 foreach d [array names def] { 417 if ![info exists inc($d)] { 418 eval $here 419 puts " Dependencies include $d, not included by $base" 420 } 421 } 422} 423 424# Check whether a given pattern occurs in a dependency tree. 425proc dep_search {target pattern mfarray} { 426 upvar $mfarray mf 427 428 set target [normalize_fname $target] 429 set deps [expand_deps $mf(deps:$target) mf] 430 if {[lsearch -glob $deps $pattern] >= 0} { 431 return 1 432 } 433 foreach d $deps { 434 if {[regexp {(.*)\.dev$} $d]} { 435 if {[dep_search $d $pattern mf]} { 436 return 1 437 } 438 } 439 } 440} 441 442# Check that makefiles agree with device definitions in a .c/.cpp file. 443proc check_c_devs {file mfarray devsarray} { 444 upvar $mfarray mf $devsarray devs 445 446 foreach d $devs($file) { 447 set mfnames [array names mf "pos:*\[/\\\]$d.dev:"] 448 switch [llength $mfnames] { 449 0 { 450 puts "No rule for $d.dev, defined in $file" 451 } 452 1 { 453 regexp {^pos:(.*):$} [lindex $mfnames 0] skip dev 454 set base [file rootname [file tail $file]] 455 if {![dep_search $dev "*\[/\\\]$base.*" mf]} { 456 puts "$base missing from dependencies of $dev" 457 } 458 } 459 default { 460 puts "Multiple rules for $d.dev, defined in $file" 461 } 462 } 463 } 464} 465 466# ---------------- Test code ---------------- # 467 468proc init_files {} { 469 global FILES 470 471 set FILES(h) {} 472 set FILES(c) {} 473 set FILES(cpp) {} 474} 475proc add_files {{dir .}} { 476 global FILES 477 478 if {$dir == "."} { 479 set pre "" 480 } else { 481 set pre $dir/ 482 } 483 set total "" 484 foreach extn {h c cpp} { 485 lappend total\ 486 [llength [set FILES($extn) [concat $FILES($extn)\ 487 [lsort [glob -nocomplain ${pre}*.$extn]]]]] 488 } 489 return $total 490} 491proc all_files {} { 492 global FILES 493 494 set all {} 495 foreach extn {h c cpp} {set all [concat $all $FILES($extn)]} 496 return $all 497} 498proc get_includes {} { 499 global INCS 500 501 puts [time {set_includes INCS [all_files]}] 502} 503proc get_gs_devices {} { 504 global DEVS 505 506 puts [time {set_devices DEVS [glob ./src/gdev*.c]}] 507} 508proc check_headers {} { 509 global FILES INCS MF 510 511 foreach h $FILES(h) { 512 check_h $h INCS MF 513 } 514} 515proc check_code {} { 516 global FILES INCS MF 517 518 foreach c [concat $FILES(c) $FILES(cpp)] { 519 check_c $c INCS MF 520 } 521} 522proc check_devices {} { 523 global DEVS MF 524 525 foreach c [array names DEVS] { 526 check_c_devs $c MF DEVS 527 } 528} 529proc top_makefiles {dir} { 530 foreach f [glob $dir/*.mak] { 531 if {[regexp {lib.mak$} $f]} {continue} 532 set mak($f) 1 533 } 534 foreach f [array names mak] { 535 set maybe_top 0 536 if {![catch {set lines [exec egrep {^(!|)include } $f]}]} { 537 foreach line [split $lines "\n"] { 538 if {[regsub {^(!|)include([ ]+)} $line {} file]} { 539 set maybe_top 1 540 regsub -all {^"|"$} $file {} file 541 regsub {^\$\([A-Z]+\)([/\\]|)} $file {} file 542 catch {unset mak($dir/$file)} 543 } 544 } 545 } 546 if {!$maybe_top} { 547 catch {unset mak($f)} 548 } 549 } 550 return [array names mak] 551} 552proc check_makefile {args} { 553 global MF 554 555 if {$args == ""} {set args {makefile}} 556 init_files 557 makefile_init MF 558 foreach f $args { 559 while {![catch {set f [file readlink $f]}]} {} 560 puts "Reading makefile $f" 561 set dir [file dirname $f] 562 if {![info exists dirs($dir)]} { 563 set dirs($dir) 1 564 puts "Scanning source directory $dir" 565 puts "[add_files $dir] files" 566 } 567 read_makefile MF $f 568 } 569 get_includes 570 #get_gs_devices 571 check_headers 572 check_code 573 #check_devices 574} 575 576if {$argv == [list "check"]} { 577 eval check_makefile [lreplace $argv 0 0] 578} 579