From ceb3507a8fca872770b3dcd7e5c5b36179ab95b0 Mon Sep 17 00:00:00 2001 From: Manoj Srivastava Date: Fri, 30 May 2008 12:42:47 -0700 Subject: Import dist_3.5-236.orig.tar.gz [dgit import orig dist_3.5-236.orig.tar.gz] --- mcon/pl/common.pl | 289 ++++++++++ mcon/pl/configure.pl | 248 +++++++++ mcon/pl/cosmetic.pl | 110 ++++ mcon/pl/depend.pl | 141 +++++ mcon/pl/eval.pl | 300 ++++++++++ mcon/pl/extract.pl | 109 ++++ mcon/pl/files.pl | 134 +++++ mcon/pl/gensym.pl | 22 + mcon/pl/init.pl | 55 ++ mcon/pl/lint.pl | 1473 ++++++++++++++++++++++++++++++++++++++++++++++++++ mcon/pl/locate.pl | 153 ++++++ mcon/pl/makefile.pl | 172 ++++++ mcon/pl/obsolete.pl | 103 ++++ mcon/pl/order.pl | 42 ++ mcon/pl/tsort.pl | 166 ++++++ mcon/pl/wanted.pl | 263 +++++++++ mcon/pl/xref.pl | 70 +++ mcon/pl/xwant.pl | 149 +++++ 18 files changed, 3999 insertions(+) create mode 100644 mcon/pl/common.pl create mode 100644 mcon/pl/configure.pl create mode 100644 mcon/pl/cosmetic.pl create mode 100644 mcon/pl/depend.pl create mode 100644 mcon/pl/eval.pl create mode 100644 mcon/pl/extract.pl create mode 100644 mcon/pl/files.pl create mode 100644 mcon/pl/gensym.pl create mode 100644 mcon/pl/init.pl create mode 100644 mcon/pl/lint.pl create mode 100644 mcon/pl/locate.pl create mode 100644 mcon/pl/makefile.pl create mode 100644 mcon/pl/obsolete.pl create mode 100644 mcon/pl/order.pl create mode 100644 mcon/pl/tsort.pl create mode 100644 mcon/pl/wanted.pl create mode 100644 mcon/pl/xref.pl create mode 100644 mcon/pl/xwant.pl (limited to 'mcon/pl') diff --git a/mcon/pl/common.pl b/mcon/pl/common.pl new file mode 100644 index 0000000..0d1ea5a --- /dev/null +++ b/mcon/pl/common.pl @@ -0,0 +1,289 @@ +;# $Id$ +;# +;# Copyright (c) 1991-1997, 2004-2006, Raphael Manfredi +;# +;# You may redistribute only under the terms of the Artistic Licence, +;# as specified in the README file that comes with the distribution. +;# You may reuse parts of this distribution only within the terms of +;# that same Artistic Licence; a copy of which may be found at the root +;# of the source tree for dist 4.0. +;# +;# $Log: common.pl,v $ +;# Revision 3.0.1.4 1994/10/29 16:35:01 ram +;# patch36: metaconfig and metaxref ignore ?F: lines from now on +;# +;# Revision 3.0.1.3 1994/05/13 15:29:04 ram +;# patch27: now understands macro definitions in ?H: lines +;# +;# Revision 3.0.1.2 1994/01/24 14:22:54 ram +;# patch16: can now define "internal use only" variables on ?MAKE: lines +;# +;# Revision 3.0.1.1 1993/10/16 13:53:29 ram +;# patch12: added support for ?M: lines and confmagic.h production +;# +;# Revision 3.0 1993/08/18 12:10:19 ram +;# Baseline for dist 3.0 netwide release. +;# +;# The list of all available units is held in @ARGV. We shall parse them and +;# extract the dependencies. A lot of global data structures are filled in +;# during this phase. +;# +;# The following two H tables are used to record each know symbol (i.e. a +;# symbol known by at least one unit), and also how many times this symbol is +;# found in the sources. If an entry for a given key is positive, then the +;# associated symbol (i.e. the key) is wanted and it will be written in the +;# Wanted file. +;# %shmaster{'$sym'} records how many times '$sym' is found in a .SH file +;# %cmaster{'SYM'} records how many times 'SYM' is found in a .c file +;# %cwanted{'SYM'} records the set of necessary shell symbols needed for SYM +;# %mwanted{'sym'} is set of C symbols needed when sym is found in .c file +;# +;# This data structure records the initializations which are requires at the +;# beginning of a Configure script. The initialization only occurs when the +;# symbol is needed. Those symbols will appear in the produced config.sh file, +;# hence the name of "master" symbols. +;# @Master records shell configuration symbols which will appear in config.sh +;# +;# The @Cond array records the conditional shell symbols, i.e. those whose +;# value may be defaulted. They will appear in the initialization section of +;# the Configure script with the default value if they are not otherwise used +;# but Configure needs a suitable value internally. +;# @Cond records symbols which are flagged as conditional in the dependencies +;# %hasdefault{'sym'} is true when the conditional 'sym' has a default value +;# +;# The %Obsolete array records the obsolecence for units or symbols. The key +;# ends with .U for units, otherwise it is a symbol. Unit's obsolescence is +;# flagged with a ?O: line (the line being the message which will be issued +;# when the unit is used) while symbol obsolecence is indicated on the leading +;# ?C: or ?S: line, between parenthesis. In that case, the value stored is the +;# new symbol which should be used insted. +;# %Obsolete{'unit.U'} is a message to be printed when obsolete unit is used +;# %Obsolete{'sym'} is the symbol to be used in place of the obsoleted 'sym' +;# +;# The $dependencies variable is used to record the dependencies extracted +;# from the units (?MAKE: line). +;# +;# During the dependency extraction. some files are produced in the .MT dir. +;# Init.U records the initialization wanted +;# Config_h.U records the informations which could go in config.h.SH +;# Extern.U records the libraries and includes wanted by each symbol +;# +;# This file is shared by both metaconfig and metaxref +;# +# Initialize the extraction process by setting some variables. +# We return a string to be eval to do more customized initializations. +sub init_extraction { + open(INIT, ">$WD/.MT/Init.U") || + die "Can't create .MT/Init.U\n"; + open(CONF_H, ">$WD/.MT/Config_h.U") || + die "Can't create .MT/Config_h.U\n"; + open(EXTERN, ">$WD/.MT/Extern.U") || + die "Can't create .MT/Extern.U\n"; + open(MAGIC_H, ">$WD/.MT/Magic_h.U") || + die "Can't create .MT/Magic_h.U\n"; + + $c_symbol = ''; # Current symbol seen in ?C: lines + $s_symbol = ''; # Current symbol seen in ?S: lines + $m_symbol = ''; # Current symbol seen in ?M: lines + $heredoc = ''; # Last "here" document symbol seen + $heredoc_nosubst = 0; # True for <<'EOM' here docs + $condlist = ''; # List of conditional symbols + $defined = ''; # List of defined symbols in the unit + $body = ''; # No procedure to handle body + $ending = ''; # No procedure to clean-up +} + +# End the extraction process +sub end_extraction { + close EXTERN; # External dependencies (libraries, includes...) + close CONF_H; # C symbol definition template + close INIT; # Required initializations + close MAGIC; # Magic C symbol redefinition templates + + print $dependencies if $opt_v; # Print extracted dependencies +} + +# Process the ?MAKE: line +sub p_make { + local($_) = @_; + local(@ary); # Locally defined symbols + local(@dep); # Dependencies + if (/^[\w+ ]*:/) { # Main dependency rule + s|^\s*||; # Remove leading spaces + chop; + s/:(.*)//; + @dep = split(' ', $1); # Dependencies + @ary = split(' '); # Locally defined symbols + foreach $sym (@ary) { + # Symbols starting with a '+' are meant for internal use only. + next if $sym =~ s/^\+//; + # Only sumbols starting with a lowercase letter are to + # appear in config.sh, excepted the ones listed in Except. + if ($sym =~ /^[_a-z]/ || $Except{$sym}) { + $shmaster{"\$$sym"} = undef; + push(@Master,"?$unit:$sym=''\n"); # Initializations + } + } + $condlist = ''; # List of conditional symbols + local($sym); # Symbol copy, avoid @dep alteration + foreach $dep (@dep) { + if ($dep =~ /^\+[A-Za-z]/) { + ($sym = $dep) =~ s|^\+||; + $condlist .= "$sym "; + push(@Cond, $sym) unless $condseen{$sym}; + $condseen{$sym}++; # Conditionally wanted + } + } + # Append to already existing dependencies. The 'defined' variable + # is set for &write_out, used to implement ?L: and ?I: canvas. It is + # reset each time a new unit is parsed. + # NB: leading '+' for defined symbols (internal use only) have been + # removed at this point, but conditional dependencies still bear it. + $defined = join(' ', @ary); # Symbols defined by this unit + $dependencies .= $defined . ':' . join(' ', @dep) . "\n"; + $dependencies .= " -cond $condlist\n" if $condlist; + } else { + $dependencies .= $_; # Building rules + } +} + +# Process the ?O: line +sub p_obsolete { + local($_) = @_; + $Obsolete{"$unit.U"} .= $_; # Message(s) to print if unit is used +} + +# Process the ?S: lines +sub p_shell { + local($_) = @_; + unless ($s_symbol) { + if (/^(\w+).*:/) { + $s_symbol = $1; + print " ?S: $s_symbol\n" if $opt_d; + } else { + warn "\"$file\", line $.: syntax error in ?S: construct.\n"; + $s_symbol = $unit; + return; + } + # Deal with obsolete symbol list (enclosed between parenthesis) + &record_obsolete("\$$_") if /\(/; + } + m|^\.\s*$| && ($s_symbol = ''); # End of comment +} + +# Process the ?C: lines +sub p_c { + local($_) = @_; + unless ($c_symbol) { + if (s/^(\w+)\s*~\s*(\S+)\s*(.*):/$1 $3:/) { + # The ~ operator aliases the main C symbol to another symbol which + # is to be used instead for definition in config.h. That is to say, + # the line '?C:SYM ~ other:' would look for symbol 'other' instead, + # and the documentation for symbol SYM would only be included in + # config.h if 'other' were actually wanted. + $c_symbol = $2; # Alias for definition in config.h + print " ?C: $1 ~ $c_symbol\n" if $opt_d; + } elsif (/^(\w+).*:/) { + # Default behaviour. Include in config.h if symbol is needed. + $c_symbol = $1; + print " ?C: $c_symbol\n" if $opt_d; + } else { + warn "\"$file\", line $.: syntax error in ?C: construct.\n"; + $c_symbol = $unit; + return; + } + # Deal with obsolete symbol list (enclosed between parenthesis) and + # make sure that list do not appear in config.h.SH by removing it. + &record_obsolete("$_") if /\(/; + s/\s*\(.*\)//; # Get rid of obsolete symbol list + } + s|^(\w+)\s*|?$c_symbol:/* $1| || # Start of comment + (s|^\.\s*$|?$c_symbol: */\n| && ($c_symbol = '', 1)) || # End of comment + s|^(.*)|?$c_symbol: *$1|; # Middle of comment + &p_config("$_"); # Add comments to config.h.SH +} + +# Process the ?H: lines +sub p_config { + local($_) = @_; + local($constraint); # Constraint to be used for inclusion + ++$old_version if s/^\?%1://; # Old version + if (s/^\?(\w+)://) { # Remove leading '?var:' + $constraint = $1; # Constraint is leading '?var' + } else { + $constraint = ''; # No constraint + } + if (/^#.*\$/) { # Look only for cpp lines + if (m|^#\$(\w+)\s+(\w+).*\$(\w+)|) { + # Case: #$d_var VAR "$var" + $constraint = $2 unless $constraint; + print " ?H: ($constraint) #\$$1 $2 \"\$$3\"\n" if $opt_d; + $cmaster{$2} = undef; + $cwanted{$2} = "$1\n$3"; + } elsif (m|^#define\s+(\w+)\((.*)\)\s+\$(\w+)|) { + # Case: #define VAR(x) $var + $constraint = $1 unless $constraint; + print " ?H: ($constraint) #define $1($2) \$$3\n" if $opt_d; + $cmaster{$1} = undef; + $cwanted{$1} = $3; + } elsif (m|^#\$define\s+(\w+)|) { + # Case: #$define VAR + $constraint = $1 unless $constraint; + print " ?H: ($constraint) #define $1\n" if $opt_d; + $cmaster{$1} = undef; + $cwanted{$1} = "define\n$unit"; + } elsif (m|^#\$(\w+)\s+(\w+)|) { + # Case: #$d_var VAR + $constraint = $2 unless $constraint; + print " ?H: ($constraint) #\$$1 $2\n" if $opt_d; + $cmaster{$2} = undef; + $cwanted{$2} = $1; + } elsif (m|^#define\s+(\w+).*\$(\w+)|) { + # Case: #define VAR "$var" + $constraint = $1 unless $constraint; + print " ?H: ($constraint) #define $1 \"\$$2\"\n" if $opt_d; + $cmaster{$1} = undef; + $cwanted{$1} = $2; + } else { + $constraint = $unit unless $constraint; + print " ?H: ($constraint) $_" if $opt_d; + } + } else { + print " ?H: ($constraint) $_" if $opt_d; + } + # If not a single ?H:. line, add the leading constraint + s/^\.// || s/^/?$constraint:/; + print CONF_H; +} + +# Process the ?M: lines +sub p_magic { + local($_) = @_; + unless ($m_symbol) { + if (/^(\w+):\s*([\w\s]*)\n$/) { + # A '?M:sym:' line implies a '?W:%<:sym' since we'll need to know + # about the wantedness of sym later on when building confmagic.h. + # Buf is sym is wanted, then the C symbol dependencies have to + # be triggered. That is done by introducing sym in the mwanted + # array, known by the Wanted file construction process... + $m_symbol = $1; + print " ?M: $m_symbol\n" if $opt_d; + $mwanted{$m_symbol} = $2; # Record C dependencies + &p_wanted("$unit:$m_symbol"); # Build fake ?W: line + } else { + warn "\"$file\", line $.: syntax error in ?M: construct.\n"; + } + return; + } + (s/^\.\s*$/?$m_symbol:\n/ && ($m_symbol = '', 1)) || # End of block + s/^/?$m_symbol:/; + print MAGIC_H; # Definition goes to confmagic.h + print " ?M: $_" if $opt_d; +} + +sub p_ignore {} # Ignore comment line +sub p_lint {} # Ignore lint directives +sub p_visible {} # No visible checking in metaconfig +sub p_temp {} # No temporary variable control +sub p_file {} # Ignore produced file directives (for now) + diff --git a/mcon/pl/configure.pl b/mcon/pl/configure.pl new file mode 100644 index 0000000..d99d74b --- /dev/null +++ b/mcon/pl/configure.pl @@ -0,0 +1,248 @@ +;# $Id$ +;# +;# Copyright (c) 1991-1997, 2004-2006, Raphael Manfredi +;# +;# You may redistribute only under the terms of the Artistic Licence, +;# as specified in the README file that comes with the distribution. +;# You may reuse parts of this distribution only within the terms of +;# that same Artistic Licence; a copy of which may be found at the root +;# of the source tree for dist 4.0. +;# +;# $Log: configure.pl,v $ +;# Revision 3.0.1.5 1995/01/30 14:47:15 ram +;# patch49: removed old "do name()" routine call constructs +;# +;# Revision 3.0.1.4 1995/01/11 15:40:02 ram +;# patch45: now allows @if statements for the add.Config_sh unit inclusion +;# +;# Revision 3.0.1.3 1994/05/06 15:21:23 ram +;# patch23: cleaned up the 'prepend' command +;# +;# Revision 3.0.1.2 1994/01/24 14:23:21 ram +;# patch16: new general <\$variable> macro substitutions in wiped units +;# +;# Revision 3.0.1.1 1993/10/16 13:54:02 ram +;# patch12: added support for ?M: lines and confmagic.h production +;# patch12: new Makefile command cm_h_weed +;# +;# Revision 3.0 1993/08/18 12:10:20 ram +;# Baseline for dist 3.0 netwide release. +;# +;# +;# This file is the heart of metaconfig. We generate a Configure script using +;# the informations gathered in the @cmdwanted array. A unit is expected to have +;# its path written in the %Unit array (indexing is done with the unit's name +;# without the .U extension). +;# +;# The units are run through a built-in interpreter before being written to +;# the Configure script. +;# +# Create the Configure script +sub create_configure { + print "Creating Configure...\n" unless $opt_s; + open(CONFIGURE,">Configure") || die "Can't create Configure: $!\n"; + open(CONF_H,">config_h.SH") || die "Can't create config_h.SH: $!\n"; + if ($opt_M) { + open(MAGIC_H,">confmagic.h") || die "Can't create confmagic.h: $!\n"; + } + + chdir('.MT') || die "Can't cd to .MT: $!\n"; + for (@cmdwanted) { + &process_command($_); # Run the makefile command + } + chdir($WD) || die "Can't cd back to $WD\n"; + close CONFIGURE; + print CONF_H "#endif\n"; # Close the opened #ifdef (see Config_h.U) + print CONF_H "!GROK!THIS!\n"; + close CONF_H; + if ($opt_M) { + print MAGIC_H "#endif\n"; # Close the opened #ifdef (see Magic_h.U) + close MAGIC_H; + } + `chmod +x Configure`; +} + +# Process a Makefile 'pick' command +sub process_command { + local($cmd, $target, $unit_name) = split(' ', $_[0]); + local($name) = $unit_name . '.U'; # Restore missing .U + local($file) = $name; # Where unit is located + unless ($file =~ m|^\./|) { # Unit produced earlier by metaconfig + $file = $Unit{$unit_name}; # Fetch unit from U directory + } + if (defined $Obsolete{$name}) { # Signal use of an obsolete unit + warn "\tObsolete unit $name is used:\n"; + local(@msg) = split(/\n/, $Obsolete{$name}); + foreach $msg (@msg) { + warn "\t $msg\n"; + } + } + die "Can't open $file.($name for target $target): $!\n" + unless open(UNIT, $file); + print "\t$cmd $file\n" if $opt_v; + &init_interp; # Initializes the interpreter + + # The 'add' command adds the unit to Configure. + if ($cmd eq 'add') { + while () { + print CONFIGURE unless &skipped || !&interpret($_); + } + } + + # The 'weed' command adds the unit to Configure, but + # makes some tests for the lines starting with '?' or '%'. + # These lines are kept only if the symbol is wanted. + elsif ($cmd eq 'weed') { + while () { + if (/^\?(\w+):/) { + s/^\?\w+:// if $symwanted{$1}; + } + if (/^%(\w+):/) { + s/^%\w+:// if $condwanted{$1}; + } + print CONFIGURE unless &skipped || !&interpret($_); + } + } + + # The 'wipe' command adds the unit to Configure, but + # also substitues some hardwired macros. + elsif ($cmd eq 'wipe') { + while () { + s//$package/g; + s//$maintloc/g; + s//$version/g; # This is metaconfig's version + s//$revision/g; # And revision information + warn "\"$file\": usage of is deprecated\n" + if s//$patchlevel/g; + s//$date/g; + s//$baserev/g; + s/<\$(\w+)>/eval("\$$1")/ge; # <$var> -> $var substitution + print CONFIGURE unless &skipped || !&interpret($_); + } + } + + # The 'add.Null' command adds empty initializations + # to Configure for all the shell variable used. + elsif ($cmd eq 'add.Null') { + for (sort @Master) { + if (/^\?(\w+):/) { + s/^\?\w+:// if $symwanted{$1}; + } + print CONFIGURE unless &skipped; + } + for (sort @Cond) { + print CONFIGURE "$_=''\n" + unless $symwanted{$_} || $hasdefault{$_}; + } + while () { + print CONFIGURE unless &skipped || !&interpret($_); + } + print CONFIGURE "CONFIG=''\n\n"; + } + + # The 'add.Config_sh' command fills in the production of + # the config.sh script within Configure. Only the used + # variable are added, the conditional ones are skipped. + elsif ($cmd eq 'add.Config_sh') { + while () { + print CONFIGURE unless &skipped || !&interpret($_); + } + for (sort @Master) { + if (/^\?(\w+):/) { + # Can't use $shmaster, because config.sh must + # also contain some internal defaults used by + # Configure (e.g. nm_opt, libc, etc...). + s/^\?\w+:// if $symwanted{$1}; + } + s/^(\w+)=''/$1='\$$1'/; + print CONFIGURE unless &skipped; + } + } + + # The 'close.Config_sh' command adds the final EOT line at + # the end of the here-document construct which produces the + # config.sh file within Configure. + elsif ($cmd eq 'close.Config_sh') { + print CONFIGURE "EOT\n\n"; # Ends up file + } + + # The 'c_h_weed' command produces the config_h.SH file. + # Only the necessary lines are kept. If no conditional line is + # ever printed, then the file is useless and will be removed. + elsif ($cmd eq 'c_h_weed') { + $printed = 0; + while () { + if (/^\?(\w+):/) { + s/^\?\w+:// if $cmaster{$1} || $symwanted{$1}; + } + unless (&skipped || !&interpret($_)) { + if (/^$/) { + print CONF_H "\n" if $printed; + $printed = 0; + } else { + print CONF_H; + ++$printed; + } + } + } + } + + # The 'cm_h_weed' command produces the confmagic.h file. + # Only the necessary lines are kept. If no conditional line is + # ever printed, then the file is useless and will be removed. + elsif ($cmd eq 'cm_h_weed') { + if ($opt_M) { + $printed = 0; + while () { + if (/^\?(\w+):/) { + s/^\?\w+:// if $cmaster{$1} || $symwanted{$1}; + } + unless (&skipped || !&interpret($_)) { + if (/^$/) { + print MAGIC_H "\n" if $printed; + $printed = 0; + } else { + print MAGIC_H; + ++$printed; + } + } + } + } + } + + # The 'prepend' command will add the content of the target to + # the current file (held in $file, the one which UNIT refers to), + # if the file is not empty. + elsif ($cmd eq 'prepend') { + if (-s $file) { + open(PREPEND, ">.prepend") || + die "Can't create .MT/.prepend: $!\n"; + open(TARGET, $Unit{$target}) || + die "Can't open unit $Unit{$target}: $!\n"; + while () { + print PREPEND unless &skipped; + } + print PREPEND ; # Now add original file contents + close PREPEND; + close TARGET; + rename('.prepend', $file) || + die "Can't rename .prepend into $file: $!\n"; + } + } + + # Command not found + else { + die "Unrecognized command from Makefile: $cmd\n"; + } + &check_state; # Make sure there are no pending statements + close UNIT; +} + +# Skip lines starting with ? or %, including all the following continuation +# lines, if any. Return 0 if the line was not to be skipped, 1 otherwise. +sub skipped { + return 0 unless /^\?|^%/; + &complete_line(UNIT) if /\\\s*$/; # Swallow continuation lines + 1; +} + diff --git a/mcon/pl/cosmetic.pl b/mcon/pl/cosmetic.pl new file mode 100644 index 0000000..d8b535b --- /dev/null +++ b/mcon/pl/cosmetic.pl @@ -0,0 +1,110 @@ +;# $Id$ +;# +;# Copyright (c) 1991-1997, 2004-2006, Raphael Manfredi +;# +;# You may redistribute only under the terms of the Artistic Licence, +;# as specified in the README file that comes with the distribution. +;# You may reuse parts of this distribution only within the terms of +;# that same Artistic Licence; a copy of which may be found at the root +;# of the source tree for dist 4.0. +;# +;# $Log: cosmetic.pl,v $ +;# Revision 3.0.1.3 1995/07/25 14:19:16 ram +;# patch56: added support for new -G option +;# +;# Revision 3.0.1.2 1995/01/30 14:47:52 ram +;# patch49: forgot to localize the spaces variable +;# +;# Revision 3.0.1.1 1993/11/10 17:39:10 ram +;# patch14: now also adds confmagic.h if not in MANIFEST.new already +;# patch14: new functions mani_add and mani_remove to factorize code +;# +;# Revision 3.0 1993/08/18 12:10:20 ram +;# Baseline for dist 3.0 netwide release. +;# +;# +# Update the MANIFEST.new file if necessary +sub cosmetic_update { + # Check for an "empty" config_h.SH (2 blank lines only). This test relies + # on the actual text held in Config_h.U. If the unit is modified, then the + # following might need adjustments. + local($blank_lines) = 0; + local($spaces) = 0; + open(CONF_H, 'config_h.SH') || die "Can't open config_h.SH\n"; + while() { + ++$blank_lines if /^$/; + } + unlink 'config_h.SH' unless $blank_lines > 3; + + open(NEWMANI,$NEWMANI); + $_ = ; + /(\S+\s+)\S+/ && ($spaces = length($1)); # Spaces wanted + close NEWMANI; + $spaces = 29 if ($spaces < 12); # Default value + open(NEWMANI,$NEWMANI); + $/ = "\001"; # Swallow the whole file + $_ = ; + $/ = "\n"; + close NEWMANI; + + &mani_add('Configure', 'Portability tool', $spaces) unless /^Configure\b/m; + &mani_add('config_h.SH', 'Produces config.h', $spaces) + unless /^config_h\.SH\b/m || !-f 'config_h.SH'; + &mani_add('confmagic.h', 'Magic symbol remapping', $spaces) + if $opt_M && !/^confmagic\.h\b/m; + + &mani_remove('config_h.SH') if /^config_h\.SH\b/m && !-f 'config_h.SH'; + &mani_remove('confmagic.h') if /^confmagic.h\b/m && !$opt_M; + + if ($opt_G) { # Want a GNU-like configure wrapper + &add_configure; + &mani_add('configure', 'GNU configure-like wrapper', $spaces) + if !/^configure\s/m && -f 'configure'; + } else { + &mani_remove('configure') if /^configure\s/m && !-f 'configure'; + } +} + +# Add file to MANIFEST.new, with properly indented comment +sub mani_add { + local($file, $comment, $spaces) = @_; + print "Adding $file to your $NEWMANI file...\n" unless $opt_s; + open(NEWMANI, ">>$NEWMANI") || warn "Can't add $file to $NEWMANI: $!\n"; + local($blank) = ' ' x ($spaces - length($file)); + print NEWMANI "${file}${blank}${comment}\n"; + close NEWMANI; +} + +# Remove file from MANIFEST.new +sub mani_remove { + local($file) = @_; + print "Removing $file from $NEWMANI...\n" unless $opt_s; + unless (open(NEWMANI, ">$NEWMANI.x")) { + warn "Can't create backup $NEWMANI copy: $!\n"; + return; + } + unless (open(OLDMANI, $NEWMANI)) { + warn "Can't open $NEWMANI: $!\n"; + return; + } + local($_); + while () { + print NEWMANI unless /^$file\b/ + } + close OLDMANI; + close NEWMANI; + rename("$NEWMANI.x", $NEWMANI) || + warn "Couldn't restore $NEWMANI from $NEWMANI.x\n"; +} + +# Copy GNU-like configure wrapper to the package root directory +sub add_configure { + if (-f "$MC/configure") { + print "Copying GNU configure-like front end...\n" unless $opt_s; + system "cp $MC/configure ./configure"; + `chmod +x configure`; + } else { + warn "Can't locate $MC/configure: $!\n"; + } +} + diff --git a/mcon/pl/depend.pl b/mcon/pl/depend.pl new file mode 100644 index 0000000..e31eded --- /dev/null +++ b/mcon/pl/depend.pl @@ -0,0 +1,141 @@ +;# $Id$ +;# +;# Copyright (c) 1991-1997, 2004-2006, Raphael Manfredi +;# +;# You may redistribute only under the terms of the Artistic Licence, +;# as specified in the README file that comes with the distribution. +;# You may reuse parts of this distribution only within the terms of +;# that same Artistic Licence; a copy of which may be found at the root +;# of the source tree for dist 4.0. +;# +;# $Log: depend.pl,v $ +;# Revision 3.0.1.3 1995/09/25 09:18:56 ram +;# patch59: new ?Y: directive to change unit layout +;# +;# Revision 3.0.1.2 1994/10/29 16:35:23 ram +;# patch36: added various escapes in strings for perl5 support +;# +;# Revision 3.0.1.1 1993/10/16 13:54:35 ram +;# patch12: added minimal support for ?P: lines (not ready yet) +;# +;# Revision 3.0 1993/08/18 12:10:21 ram +;# Baseline for dist 3.0 netwide release. +;# +;# Metaconfig-dependent part of the dependency extraction. +;# +# Process the ?W: lines +sub p_wanted { + # Syntax is ?W:: + local($active) = $_[0] =~ /^([^:]*):/; # Symbols to activate + local($look_symbols) = $_[0] =~ /:(.*)/; # When those are used + local(@syms) = split(/ /, $look_symbols); # Keep original spacing info + $active =~ s/\s+/\n/g; # One symbol per line + + # Concatenate quoted strings, so saying something like 'two words' will + # be introduced as one single symbol "two words". + local(@symbols); # Concatenated symbols to look for + local($concat) = ''; # Concatenation buffer + foreach (@syms) { + if (s/^\'//) { + $concat = $_; + } elsif (s/\'$//) { + push(@symbols, $concat . ' ' . $_); + $concat = ''; + } else { + push(@symbols, $_) unless $concat; + $concat .= ' ' . $_ if $concat; + } + } + + # Now record symbols in master and wanted tables + foreach (@symbols) { + $cmaster{$_} = undef; # Asks for look-up in C files + $cwanted{$_} = "$active" if $active; # Shell symbols to activate + } + + delete @cmaster{keys %excluded_symbol}; + delete @cwanted{keys %excluded_symbol}; +} + +# Process the ?INIT: lines +sub p_init { + local($_) = @_; + print INIT "?$unit:", $_; # Wanted only if unit is loaded +} + +# Process the ?D: lines +sub p_default { + local($_) = @_; + s/^([A-Za-z_]+)=(.*)/\@if !$1\n%$1:$1=$2\n\@define $1\n\@end/ + && ($hasdefault{$1}++, print INIT $_); +} + +# Process the ?P: lines +sub p_public { + local($_) = @_; + local($csym); # C symbol(s) we're trying to look at + local($nosym); # List of symbol(s) which mustn't be wanted + local($cfile); # Name of file implementing csym (no .ext) + ($csym, $nosym, $cfile) = /([^()]+)\s*(\(.*\))\s*:\s*(\S+)/; + unless ($csym eq '' || $cfile eq '') { + # Add dependencies for each C symbol, of the form: + # -pick public + # and the file will be added to config.c whenever sym is wanted and + # none of the notdef symbols is wanted. + foreach $sym (split(' ', $csym)) { + $dependencies .= "\t-pick public $sym $cfile $nosym\n"; + } + } +} + +# Process the ?Y: lines +# Valid layouts are for now are: top, bottom, default. +# +# NOTA BENE: +# This routine relies on the $defined variable, a global variable set +# during the ?MAKE: processing, which lists all the defined symbols in +# the unit (the optional leading '+' for internal symbols has been removed +# if present). +# +# The routine fills up a %Layout table, indexed by symbol, yielding the +# layout imposed to this unit. That table will then be used later on when +# we sort wanted symbols for the Makefile. +sub p_layout { + local($_) = @_; + local($layout) = /^\s*(\w+)/; + $layout =~ tr/A-Z/a-z/; # Case is not significant for layouts + unless (defined $Lcmp{$layout}) { + warn "\"$file\", line $.: unknown layout directive '$layout'.\n"; + return; + } + foreach $sym (split(' ', $defined)) { + $Layout{$sym} = $Lcmp{$layout}; + } +} + +# Process the ?L: lines +# There should not be any '-l' in front of the library name +sub p_library { + &write_out("L:$_"); +} + +# Process the ?I: lines +sub p_include { + &write_out("I:$_"); +} + +# Write out line in file Extern.U. The information recorded there has the +# following prototypical format: +# ?symbol:L:inet bsd +# If 'symbol' is wanted, then 'inet bsd' will be added to $libswanted. +sub write_out { + local($_) = @_; + local($target) = $defined; # By default, applies to defined symbols + $target = $1 if s/^(.*)://; # List is qualified "?L:target:symbols" + local(@target) = split(' ', $target); + chop; + foreach $key (@target) { + print EXTERN "?$key:$_\n"; # EXTERN file defined in xref.pl + } +} + diff --git a/mcon/pl/eval.pl b/mcon/pl/eval.pl new file mode 100644 index 0000000..c4c1d76 --- /dev/null +++ b/mcon/pl/eval.pl @@ -0,0 +1,300 @@ +;# $Id$ +;# +;# Copyright (c) 1991-1997, 2004-2006, Raphael Manfredi +;# +;# You may redistribute only under the terms of the Artistic Licence, +;# as specified in the README file that comes with the distribution. +;# You may reuse parts of this distribution only within the terms of +;# that same Artistic Licence; a copy of which may be found at the root +;# of the source tree for dist 4.0. +;# +;# $Log: eval.pl,v $ +;# Revision 3.0.1.1 1995/01/30 14:48:37 ram +;# patch49: removed old "do name()" routine call constructs +;# +;# Revision 3.0 1993/08/18 12:10:22 ram +;# Baseline for dist 3.0 netwide release. +;# +;# +;# The built-in interpreter +;# +package interpreter; + +# States used by our interpeter -- in sync with @Keep +sub main'init_keep { + # Status in which we keep lines -- $Keep[$status] + @Keep = (0, 1, 1, 0, 1); + + # Available status ($status) + $SKIP = 0; + $IF = 1; + $ELSE = 2; + $NOT = 3; + $OUT = 4; +} + +# Priorities for operators -- magic numbers :-) +sub main'init_priority { + $Priority{'&&'} = 4; + $Priority{'||'} = 3; +} + +# Initializes the state stack of the interpreter +sub main'init_interp { + @state = (); + push(@state, $OUT); +} + +# Print error messages -- asssumes $unit and $. correctly set. +sub error { + warn "\"$main'file\", line $.: @_.\n"; +} + +# If some states are still in the stack, warn the user +sub main'check_state { + &error("one statement pending") if $#state == 1; + &error("$#state statements pending") if $#state > 1; +} + +# Add a value on the stack, modified by all the monadic operators. +# We use the locals @val and @mono from eval_expr. +sub push_val { + local($val) = shift(@_); + while ($#mono >= 0) { + # Cheat... the only monadic operator is '!'. + pop(@mono); + $val = !$val; + } + push(@val, $val); +} + +# Execute a stacked operation, leave result in stack. +# We use the locals @val and @op from eval_expr. +# If the value stack holds only one operand, do nothing. +sub execute { + return unless $#val > 0; + local($op) = pop(@op); + local($val1) = pop(@val); + local($val2) = pop(@val); + push(@val, eval("$val1 $op $val2") ? 1: 0); +} + +# Given an operator, either we add it in the stack @op, because its +# priority is lower than the one on top of the stack, or we first execute +# the stacked operations until we reach the end of stack or an operand +# whose priority is lower than ours. +# We use the locals @val and @op from eval_expr. +sub update_stack { + local($op) = shift(@_); # Operator + if (!$Priority{$op}) { + &error("illegal operator $op"); + return; + } else { + if ($#val < 0) { + &error("missing first operand for '$op' (diadic operator)"); + return; + } + # Because of the special behaviour of do-SUBR with the while modifier, + # I'm using a while-BLOCK construct. I consider this to be a bug of perl + # 4.0 PL19, although it is clearly documented in the man page. + while ( + $Priority{$op[$#op]} > $Priority{$op} # Higher priority op + && $#val > 0 # At least 2 values + ) { + &execute; # Execute an higher priority stacked operation + } + push(@op, $op); # Everything at higher priority has been executed + } +} + +# This is the heart of our little interpreter. Here, we evaluate +# a logical expression and return its value. +sub eval_expr { + local(*expr) = shift(@_); # Expression to parse + local(@val) = (); # Stack of values + local(@op) = (); # Stack of diadic operators + local(@mono) =(); # Stack of monadic operators + local($tmp); + $_ = $expr; + while (1) { + s/^\s+//; # Remove spaces between words + # The '(' construct + if (s/^\(//) { + &push_val(&eval_expr(*_)); + # A final '\' indicates an end of line + &error("missing final parenthesis") if !s/^\\//; + } + # Found a ')' or end of line + elsif (/^\)/ || /^$/) { + s/^\)/\\/; # Signals: left parenthesis found + $expr = $_; # Remove interpreted stuff + &execute() while $#val > 0; # Executed stacked operations + while ($#op >= 0) { + $_ = pop(@op); + &error("missing second operand for '$_' (diadic operator)"); + } + return $val[0]; + } + # A perl statement '{{' + elsif (s/^\{\{//) { + if (s/^(.*)\}\}//) { + &push_val((system + ('perl','-e', "if ($1) {exit 0;} else {exit 1;}" + ))? 0 : 1); + } else { + &error("incomplete perl statement"); + } + } + # A shell statement '{' + elsif (s/^\{//) { + if (s/^(.*)\}//) { + &push_val((system + ("if $1 >/dev/null 2>&1; then exit 0; else exit 1; fi" + ))? 0 : 1); + } else { + &error("incomplete shell statement"); + } + } + # Operator '||' and '&&' + elsif (s/^(\|\||&&)//) { + $tmp = $1; # Save for perl5 (Dataloaded update_stack) + &update_stack($tmp); + } + # Unary operator '!' + elsif (s/^!//) { + push(@mono,'!'); + } + # Everything else is a test for a defined value + elsif (s/^([\?%]?\w+)//) { + $tmp = $1; + # Test for wanted + if ($tmp =~ s/^\?//) { + &push_val(($main'symwanted{$tmp})? 1 : 0); + } + # Test for conditionally wanted + elsif ($tmp =~ s/^%//) { + &push_val(($main'condwanted{$tmp})? 1 : 0); + } + # Default: test for definition (see op @define) + else { + &push_val(( + $main'symwanted{$tmp} || + $main'cmaster{$tmp} || + $main'userdef{$tmp}) ? 1 : 0); + } + } + # An error occured -- we did not recognize the expression + else { + s/^([^\s\(\)\{\|&!]+)//; # Skip until next meaningful char + } + } +} + +# Given an expression in a '@' command, returns a boolean which is +# the result of the evaluation. Evaluate is collecting all the lines +# in the expression into a single string, and then calls eval_expr to +# really evaluate it. +sub evaluate { + local($val); # Value returned + local($expr) = ""; # Expression to be parsed + chop; + while (s/\\$//) { # While end of line escaped + $expr .= $_; + $_ = ; # Fetch next line + unless ($_) { + &error("EOF in expression"); + last; + } + chop; + } + $expr .= $_; + while ($expr ne '') { + $val = &eval_expr(*expr); # Expression will be modified + # We return from eval_expr either when a closing parenthisis + # is found, or when the expression has been fully analysed. + &error("extra closing parenthesis ignored") if $expr ne ''; + } + $val; +} + +# Given a line, we search for commands (lines starting with '@'). +# If there is no command in the line, then we return the boolean state. +# Otherwise, the command is analysed and a new state is computed. +# The returned value of interpret is 1 if the line is to be printed. +sub main'interpret { + local($value); + local($status) = $state[$#state]; # Current status + if (s|^\s*@\s*(\w+)\s*(.*)|$2|) { + local($cmd) = $1; + $cmd =~ y/A-Z/a-z/; # Canonicalize to lower case + # The 'define' command + if ($cmd eq 'define') { + chop; + $userdef{$_}++ if $Keep[$status]; + return 0; + } + # The 'if' command + elsif ($cmd eq 'if') { + # We always evaluate, in order to find possible errors + $value = &evaluate($_); + if (!$Keep[$status]) { + # We have to skip until next 'end' + push(@state, $SKIP); # Record structure + return 0; + } + if ($value) { # True + push(@state, $IF); + return 0; + } else { # False + push(@state, $NOT); + return 0; + } + } + # The 'else' command + elsif ($cmd eq 'else') { + &error("expression after 'else' ignored") if /\S/; + $state[$#state] = $SKIP if $state[$#state] == $IF; + return 0 if $state[$#state] == $SKIP; + if ($state[$#state] == $OUT) { + &error("unexpected 'else'"); + return 0; + } + $state[$#state] = $ELSE; + return 0; + } + # The 'elsif' command + elsif ($cmd eq 'elsif') { + # We always evaluate, in order to find possible errors + $value = &evaluate($_); + $state[$#state] = $SKIP if $state[$#state] == $IF; + return 0 if $state[$#state] == $SKIP; + if ($state[$#state] == $OUT) { + &error("unexpected 'elsif'"); + return 0; + } + if ($value) { # True + $state[$#state] = $IF; + return 0; + } else { # False + $state[$#state] = $NOT; + return 0; + } + } + # The 'end' command + elsif ($cmd eq 'end') { + &error("expression after 'end' ignored") if /\S/; + pop(@state); + &error("unexpected 'end'") if $#state < 0; + return 0; + } + # Unknown command + else { + &error("unknown command '$cmd'"); + return 0; + } + } + $Keep[$status]; +} + +package main; + diff --git a/mcon/pl/extract.pl b/mcon/pl/extract.pl new file mode 100644 index 0000000..385b751 --- /dev/null +++ b/mcon/pl/extract.pl @@ -0,0 +1,109 @@ +;# $Id$ +;# +;# Copyright (c) 1991-1997, 2004-2006, Raphael Manfredi +;# +;# You may redistribute only under the terms of the Artistic Licence, +;# as specified in the README file that comes with the distribution. +;# You may reuse parts of this distribution only within the terms of +;# that same Artistic Licence; a copy of which may be found at the root +;# of the source tree for dist 4.0. +;# +;# $Log: extract.pl,v $ +;# Revision 3.0.1.1 1994/05/06 15:21:43 ram +;# patch23: now saves the last unit line value for metalint +;# +;# Revision 3.0 1993/08/18 12:10:22 ram +;# Baseline for dist 3.0 netwide release. +;# +;# +;# This is the heart of the dependency extractor. Each control line is +;# processed. The dependencies are stored in $dependencies. +;# +# Extract dependencies from units held in @ARGV +sub extract_dependencies { + local($proc); # Procedure used to handle a ctrl line + local($file); # Current file scanned + local($dir, $unit); # Directory and unit's name + local($old_version) = 0; # True when old-version unit detected + local($mc) = "$MC/U"; # Public metaconfig directory + local($line); # Last processed line for metalint + + printf "Extracting dependency lists from %d units...\n", $#ARGV+1 + unless $opt_s; + + chdir $WD; # Back to working directory + &init_extraction; # Initialize extraction files + $dependencies = ' ' x (50 * @ARGV); # Pre-extend + $dependencies = ''; + + # We do not want to use the <> construct here, because we need the + # name of the opened files (to get the unit's name) and we want to + # reset the line number for each files, and do some pre-processing. + + file: while ($file = shift(@ARGV)) { + close FILE; # Reset line number + $old_version = 0; # True if unit is an old version + if (open(FILE, $file)) { + ($dir, $unit) = ('', $file) + unless ($dir, $unit) = ($file =~ m|(.*)/(.*)|); + $unit =~ s|\.U$||; # Remove extension + } else { + warn("Can't open $file.\n"); + } + # If unit is in the standard public directory, keep only the unit name + $file = "$unit.U" if $dir eq $mc; + print "$dir/$unit.U:\n" if $opt_d; + line: while () { + $line = $_; # Save last processed unit line + if (s/^\?([\w\-]+)://) { # We may have found a control line + $proc = $Depend{$1}; # Look for a procedure to handle it + unless ($proc) { # Unknown control line + $proc = $1; # p_unknown expects symbol in '$proc' + eval '&p_unknown'; # Signal error (metalint only) + next line; # And go on next line + } + # Long lines may be escaped with a final backslash + $_ .= &complete_line(FILE) if s/\\\s*$//; + # Run macros substitutions + s/%)); + next file; + } + } + } continue { + warn(" Warning: $file is a pre-3.0 version.\n") if $old_version; + &$ending($line) if $ending; # Post-processing for metalint + } + + &end_extraction; # End the extraction process +} + +# The first line was escaped with a final \ character. Every following line +# is to be appended to it (until we found a real \n not escaped). Note that +# the leading spaces of the continuation line are removed, so any space should +# be added before the former \ if needed. +sub complete_line { + local($file) = @_; # File where lines come from + local($_); + local($read) = ''; # Concatenation of all the continuation lines found + while (<$file>) { + s/^\s+//; # Remove leading spaces + if (s/\\\s*$//) { # Still followed by a continuation line + $read .= $_; + } else { # We've reached the end of the continuation + return $read . $_; + } + } +} + diff --git a/mcon/pl/files.pl b/mcon/pl/files.pl new file mode 100644 index 0000000..a7d26a6 --- /dev/null +++ b/mcon/pl/files.pl @@ -0,0 +1,134 @@ +;# $Id$ +;# +;# Copyright (c) 1991-1997, 2004-2006, Raphael Manfredi +;# +;# You may redistribute only under the terms of the Artistic Licence, +;# as specified in the README file that comes with the distribution. +;# You may reuse parts of this distribution only within the terms of +;# that same Artistic Licence; a copy of which may be found at the root +;# of the source tree for dist 4.0. +;# +;# $Log: files.pl,v $ +;# Revision 3.0.1.2 1994/10/29 16:35:48 ram +;# patch36: added user-defined file extension support for lookups +;# +;# Revision 3.0.1.1 1993/10/16 13:54:55 ram +;# patch12: now skip confmagic.h when -M option is used +;# +;# Revision 3.0 1993/08/18 12:10:23 ram +;# Baseline for dist 3.0 netwide release. +;# +;# +;# These two arrays record the file names of the files which may (or may not) +;# contain shell or C symbols known by metaconfig. +;# @SHlist records the .SH files +;# @clist records the C-like files (i.e. .[chyl]) +;# +;# The extensions are actually computed dynamically from the definitions held +;# in the $cext and $shext variables from .package so that people can add new +;# extensions to their packages. For instance, perl5 adds .xs files holding +;# some C symbols. +;# +;# The read_exclusions() routine honours the .package $exclusions_file +;# variable if its argument is undefined. +;# +# Extract filenames from manifest +sub extract_filenames { + &build_filext; # Construct &is_cfile and &is_shfile + print "Extracting filenames (C and SH files) from $NEWMANI...\n" + unless $opt_s; + open(NEWMANI,$NEWMANI) || die "Can't open $NEWMANI.\n"; + local($file); + while () { + ($file) = split(' '); + next if $file eq 'config_h.SH'; # skip config_h.SH + next if $file eq 'Configure'; # also skip Configure + next if $file eq 'confmagic.h' && $opt_M; + push(@SHlist, $file) if &is_shfile($file); + push(@clist, $file) if &is_cfile($file); + } +} + +# Construct two file identifiers based on the file suffix: one for C files, +# and one for SH files (using the $cext and $shext variables) defined in +# the .package file. +# The &is_cfile and &is_shfile routine may then be called to known whether +# a given file is a candidate for holding C or SH symbols. +sub build_filext { + &build_extfun('is_cfile', $cext, '.c .h .y .l'); + &build_extfun('is_shfile', $shext, '.SH'); +} + +# Build routine $name to identify extensions listed in $exts, ensuring +# that $minimum is at least matched (both to be backward compatible with +# older .package and because it is really the minimum requirred). +sub build_extfun { + local($name, $exts, $minimum) = @_; + local(@single); # Single letter dot extensions (may be grouped) + local(@others); # Other extensions + local(%seen); # Avoid duplicate extensions + foreach $ext (split(' ', "$exts $minimum")) { + next if $seen{$ext}++; + if ($ext =~ s/^\.(\w)$/$1/) { + push(@single, $ext); + } else { + # Convert into perl's regexp + $ext =~ s/\./\\./g; # Escape . + $ext =~ s/\?/./g; # ? turns into . + $ext =~ s/\*/.*/g; # * turns into .* + push(@others, $ext); + } + } + local($fn) = &q(<) { + if (/^\s*#|^\s*$/) { + # comment or blank line, ignore + } + elsif (/^\s*(\w+)\s*$/) { + $excluded_symbol{$1} = 1; + } + else { + die "$filename:$.: unrecognised line\n"; + } + } + close(EXCLUSIONS) || die "Can't close $filename: $!\n"; +} + diff --git a/mcon/pl/gensym.pl b/mcon/pl/gensym.pl new file mode 100644 index 0000000..4f65065 --- /dev/null +++ b/mcon/pl/gensym.pl @@ -0,0 +1,22 @@ +;# $Id$ +;# +;# Copyright (c) 1991-1997, 2004-2006, Raphael Manfredi +;# +;# You may redistribute only under the terms of the Artistic Licence, +;# as specified in the README file that comes with the distribution. +;# You may reuse parts of this distribution only within the terms of +;# that same Artistic Licence; a copy of which may be found at the root +;# of the source tree for dist 4.0. +;# +;# $Log: gensym.pl,v $ +;# Revision 3.0 1993/08/18 12:10:24 ram +;# Baseline for dist 3.0 netwide release. +;# +;# +# Create a new symbol name each time it is invoked. That name is suitable for +# usage as a perl variable name. +sub gensym { + $Gensym = 'AAAAA' unless $Gensym; + $Gensym++; +} + diff --git a/mcon/pl/init.pl b/mcon/pl/init.pl new file mode 100644 index 0000000..c60d64c --- /dev/null +++ b/mcon/pl/init.pl @@ -0,0 +1,55 @@ +;# $Id$ +;# +;# Copyright (c) 1991-1997, 2004-2006, Raphael Manfredi +;# +;# You may redistribute only under the terms of the Artistic Licence, +;# as specified in the README file that comes with the distribution. +;# You may reuse parts of this distribution only within the terms of +;# that same Artistic Licence; a copy of which may be found at the root +;# of the source tree for dist 4.0. +;# +;# $Log: init.pl,v $ +;# Revision 3.0.1.2 1995/09/25 09:19:06 ram +;# patch59: new ?Y: directive to change unit layout +;# +;# Revision 3.0.1.1 1993/10/16 13:55:06 ram +;# patch12: now knows about ?M: lines +;# +;# Revision 3.0 1993/08/18 12:10:24 ram +;# Baseline for dist 3.0 netwide release. +;# +;# +# The %Depend array records the functions we use to process the configuration +# lines in the unit, with a special meaning. It is important that all the +# known control symbols be listed below, so that metalint does not complain. +# The %Lcmp array contains valid layouts and their comparaison value. +sub init_depend { + %Depend = ( + 'MAKE', 'p_make', # The ?MAKE: line records dependencies + 'INIT', 'p_init', # Initializations printed verbatim + 'LINT', 'p_lint', # Hints for metalint + 'RCS', 'p_ignore', # RCS comments are ignored + 'C', 'p_c', # C symbols + 'D', 'p_default', # Default value for conditional symbols + 'E', 'p_example', # Example of usage + 'F', 'p_file', # Produced files + 'H', 'p_config', # Process the config.h lines + 'I', 'p_include', # Added includes + 'L', 'p_library', # Added libraries + 'M', 'p_magic', # Process the confmagic.h lines + 'O', 'p_obsolete', # Unit obsolescence + 'P', 'p_public', # Location of PD implementation file + 'S', 'p_shell', # Shell variables + 'T', 'p_temp', # Shell temporaries used + 'V', 'p_visible', # Visible symbols like 'rp', 'dflt' + 'W', 'p_wanted', # Wanted value for interpreter + 'X', 'p_ignore', # User comment is ignored + 'Y', 'p_layout', # User-defined layout preference + ); + %Lcmp = ( + 'top', -1, + 'default', 0, + 'bottom', 1, + ); +} + diff --git a/mcon/pl/lint.pl b/mcon/pl/lint.pl new file mode 100644 index 0000000..0120c51 --- /dev/null +++ b/mcon/pl/lint.pl @@ -0,0 +1,1473 @@ +;# $Id$ +;# +;# Copyright (c) 1991-1997, 2004-2006, Raphael Manfredi +;# +;# You may redistribute only under the terms of the Artistic Licence, +;# as specified in the README file that comes with the distribution. +;# You may reuse parts of this distribution only within the terms of +;# that same Artistic Licence; a copy of which may be found at the root +;# of the source tree for dist 4.0. +;# +;# $Log: lint.pl,v $ +;# Revision 3.0.1.10 1997/02/28 16:31:53 ram +;# patch61: added support for ?F: lines to monitor file usage +;# patch61: now honours "create" and "empty" lint directives +;# +;# Revision 3.0.1.9 1995/09/25 09:19:15 ram +;# patch59: new ?Y: directive to change unit layout +;# +;# Revision 3.0.1.8 1995/07/25 14:19:47 ram +;# patch56: will now check : comments line for potential danger +;# +;# Revision 3.0.1.7 1994/10/29 16:36:14 ram +;# patch36: now extensively checks created files thanks to new ?F: lines +;# +;# Revision 3.0.1.6 1994/05/13 15:29:09 ram +;# patch27: now understands macro definitions in ?H: lines +;# +;# Revision 3.0.1.5 1994/05/06 15:27:48 ram +;# patch23: now warns for units ending with non-blank line +;# patch23: warn for units where last line is not new-line terminated +;# +;# Revision 3.0.1.4 1994/01/24 14:28:40 ram +;# patch16: now knows about "internal use only" variables on ?MAKE: lines +;# patch16: now suppress "read-only var set" message when change hint +;# +;# Revision 3.0.1.3 1993/11/10 17:39:39 ram +;# patch14: now spots stale ?M: dependencies +;# +;# Revision 3.0.1.2 1993/10/16 13:55:26 ram +;# patch12: now checks ?M: lines also +;# +;# Revision 3.0.1.1 1993/08/25 14:03:40 ram +;# patch6: now correctly signals conditional dependencies with no default +;# +;# Revision 3.0 1993/08/18 12:10:25 ram +;# Baseline for dist 3.0 netwide release. +;# +;# The list of all available units is held in @ARGV. We shall parse them and +;# extract the dependencies. A lot of global data structures are filled in +;# during this phase. +;# +# Initialize the extraction process by setting some variables. +# We return a string to be eval'ed to do more customized initializations. +sub init_extraction { + $c_symbol = ''; # Current symbol seen in ?C: lines + $s_symbol = ''; # Current symbol seen in ?S: lines + $m_symbol = ''; # Current symbol seen in ?M: lines + $h_section = 0; # 0 = no ?H: yet, 1 = in ?H:, 2 = ?H:. seen + $h_section_warned = 0; # Whether we warned about terminated ?H: section + $heredoc = ''; # Last "here" document symbol seen + $heredoc_nosubst = 0; # True for <<'EOM' here docs + $heredoc_line = 0; # Line were last "here" document started + $last_interpreted = 0; # True when last line was an '@' one + $past_first_line = 0; # True when first body line was already seen + $wiped_unit = 0; # True if unit will be "wiped" for macro subst + %csym = (); # C symbols described + %ssym = (); # Shell symbols described + %hcsym = (); # C symbols used by ?H: lines + %hssym = (); # Shell symbols used by ?H: lines + %msym = (); # Magic symbols defined by ?M: lines + %mdep = (); # C symbol dependencies introduced by ?M: + %symset = (); # Records all the shell symbol set + %symused = (); # Records all the shell symbol used + %tempseen = (); # Temporary shell variable seen + %fileseen = (); # Produced files seen + %fileused = (); # Files used, by unit (private UU files) + %filemisused = (); # Files not used as ./file or ...UU/file + %filetmp = (); # Local temporary files in ?F: directives + %filesetin = (); # Lists units defining a temporary file + %filecreated = (); # Records files created in this unit + %prodfile = (); # Unit where a given file is said to be created + %defseen = (); # Symbol defintions claimed + %lintset = (); # Symbols declared set by a ?LINT: line + %lintsdesc = (); # Symbols declared described by a ?LINT: line + %lintcdesc = (); # Symbols declared described by a ?LINT: line + %lintseen = (); # Symbols declared known by a ?LINT: line + %lintchange = (); # Symbols declared changed by a ?LINT: line + %lintuse = (); # Symbols declared used by unit + %lintextern = (); # Symbols known to be externally defined + %lintcreated = (); # Files declared as created by a ?LINT: line + %linthere = (); # Unclosed here document from ?LINT: line + %lintnothere = (); # False here document names, from ?LINT: line + %lintfused = (); # Records files markedas used in ?LINT: line + %lintchange_used = (); # Tracks symbols for which %lintchange was used + %lintuse_used = (); # Tracks symbols for which %lintuse was used + %lintseen_used = (); # Tracks symbols for which %lintseen was used + %lintcdesc_used = (); # Tracks symbols for which %lintcdesc was used + %lintsdesc_used = (); # Tracks symbols for which %lintsdesc was used + %lintset_used = (); # Tracks symbols for which %lintset was used + %lintnocomment = (); # Signals it's OK for unit to lack a : comment + %condsym = (); # Records all the conditional symbols + %condseen = (); # Records conditional dependencies + %depseen = (); # Records full dependencies + %shvisible = (); # Records units making a symbol visible + %shspecial = (); # Records special units listed as wanted + %shdepend = (); # Records units listed in one's dependency list + %shmaster = (); # List of units defining a shell symbol + %cmaster = (); # List of units defining a C symbol + %symdep = (); # Records units where symbol is a dependency + @make = (); # Records make dependency lines + $body = 'p_body'; # Procedure to handle body + $ending = 'p_end'; # Called at the end of each unit + @wiping = # The keywords we recognize for "wiped" units + qw( + PACKAGENAME + MAINTLOC + VERSION + PATCHLEVEL + REVISION + DATE + BASEREV + ); +} + +# End the extraction process +sub end_extraction { +} + +# Process the command line of ?MAKE: lines +sub p_make_command { + local ($_) = @_; + my $where = "\"$file\", line $. (?MAKE:)"; + unless (s/^\t+//) { + warn "$where: command line must start with a leading TAB character.\n"; + s/^\s+//; # Remove spaces and continue + } + return unless s/^-?pick\b//; + # Validate the special "pick" make command, processed internally + # by metaconfig. + my %valid = map { $_ => 1 } qw( + add add.Config_sh add.Null + c_h_weed cm_h_weed close.Config_sh + prepend weed wipe + + ); + my $cmd; + $cmd = $1 if s/^\s+(\S+)//; + unless (defined $cmd) { + warn "$where: pick needs a command argument.\n"; + return; + } + $wiped_unit++ if $cmd eq 'wipe'; + warn "$where: unknown pick command '$cmd'.\n" unless $valid{$cmd}; + s/^\s+//; + unless (s/^\$\@//) { + warn "$where: third pick argument must be \$\@\n"; + return; + } + s/^\s+//; + my $target; + $target = $1 if s/^(\S+)//; + unless (defined $target) { + warn "$where: fourth pick argument is missing\n"; + return; + } + return if $target =~ m|^\./|; + warn "$where: weird fourth argument '$target' to pick.\n" + unless $target =~ /^\w+$/; + warn "$where: fourth pick argument should probably be the %< macro.\n" + unless $target eq $unit; +} + +# Process the ?MAKE: line +sub p_make { + local($_) = @_; + local(@ary); # Locally defined symbols + local(@dep); # Dependencies + local($where) = "\"$file\", line $. (?MAKE:)"; + unless (/^[\w+ ]*:/) { + &p_make_command; + return; # We only want the main dependency rule + } + warn "$where: ignoring duplicate dependency listing line.\n" + if $makeseen{$unit}++; + return if $makeseen{$unit} > 1; + + # Reset those once for every unit + # (assuming there is only one depend line) + $h_section = 0; # 0 = no ?H: yet, 1 = in ?H:, 2 = ?H:. seen + $h_section_warned = 0; # Whether we warned about terminated ?H: section + $wiped_unit = 0; # Whether macros like " will be wiped + undef %condseen; + undef %depseen; + undef %defseen; + undef %tempseen; + undef %symset; + undef %symused; + undef %csym; + undef %ssym; + undef %hcsym; + undef %hssym; + undef %lintuse; + undef %lintuse_used; + undef %lintseen; + undef %lintchange; + undef %lintchange_used; + undef %lintextern; + undef %lintcreated; + undef %fileseen; + undef %lintseen_used; + undef %filetmp; + undef %filecreated; + undef %linthere; + undef %lintnothere; + undef %lintfused; + undef %lintsdesc; + undef %lintsdesc_used; + undef %lintcdesc; + undef %lintcdesc_used; + undef %lintset; + undef %lintset_used; + + s|^\s*||; # Remove leading spaces + chop; + s/:(.*)//; + @dep = split(' ', $1); # Dependencies + @ary = split(' '); # Locally defined symbols + local($nowarn); # True when +Special is seen + foreach $sym (@ary) { + # Ignore "internal use only" symbols as far as metalint goes. + # Actually, we record the presence of a '+' in front of a special + # unit name and use that as a hint to suppress the presence of that + # special unit in the defined symbol section. + $nowarn = ($sym =~ s/^\+//); + + # We record for each shell symbol the list of units which claim to make + # it, so as to report duplicates. + if ($sym =~ /^[_a-z]/ || $Except{$sym}) { + $shmaster{"\$$sym"} .= "$unit "; + ++$defseen{$sym}; + } else { + warn "$where: special unit '$sym' should not be listed as made.\n" + unless $sym eq $unit || $nowarn; + } + } + # Record dependencies for later perusal + push(@make, join(' ', @ary) . ':' . join(' ', @dep)); + foreach $sym (@dep) { + if ($sym =~ /^\+[_A-Za-z]/) { + $sym =~ s|^\+||; + ++$condseen{$sym}; # Conditional symbol wanted + ++$condsym{$sym}; # %condsym has a greater lifetime + } else { + ++$depseen{$sym}; # Full dependency + } + + # Each 'wanted' special unit (i.e. one starting with a capital letter) + # is remembered, so as to prevent exported symbols from being reported + # as "undefined". For instance, Myread exports $dflt, $ans and $rp. + $shspecial{$unit} .= "$sym " if substr($sym, 0, 1) =~ /^[A-Z]/; + + # Record all known dependencies (special or not) for this unit + $shdepend{$unit} .= "$sym "; + + # Remember where wanted symbol is defined, so that we can report + # stale dependencies later on (i.e. dependencies which refer to non- + # existent symbols). + $symdep{$sym} .= "$unit "; # This symbol is wanted here + } + # Make sure we do not want a symbol twice, nor do we want it once as a full + # dependency and once as a conditional dependency. + foreach $sym (@dep) { + if ($sym =~ /^\+[_A-Za-z]/) { + $sym =~ s|^\+||; + warn "$where: '+$sym' is listed $condseen{$sym} times.\n" + if $condseen{$sym} > 1; + $condseen{$sym} = 1 if $condseen{$sym}; # Avoid multiple messages + } else { + warn "$where: '$sym' is listed $depseen{$sym} times.\n" + if $depseen{$sym} > 1; + $depseen{$sym} = 1 if $depseen{$sym}; # Avoid multiple messages + } + warn "$where: '$sym' listed as both conditional and full dependency.\n" + if $condseen{$sym} && $depseen{$sym}; + } + # Make sure every unit "inherits" from the symbols exported by 'Init'. + $shspecial{$unit} .= 'Init ' unless $shspecial{$unit} =~ /Init\b/; +} + +# Process the ?O: line +sub p_obsolete { + local($_) = @_; + chop; + $Obsolete{"$unit.U"} = $_; # Message to print if unit is used +} + +# Process the ?S: lines +sub p_shell { + local($_) = @_; + local($where) = "\"$file\", line $. (?S:)"; + warn "$where: directive should come after ?MAKE declarations.\n" + unless $makeseen{$unit}; + if (/^(\w+)\s*(\(.*\))*\s*:/) { + &check_last_declaration; + $s_symbol = $1; + print " ?S: $s_symbol\n" if $opt_d; + # Make sure we do not define symbol twice and that the symbol is indeed + # listed in the ?MAKE: line. + warn "$where: duplicate description for variable '\$$s_symbol'.\n" + if $ssym{$s_symbol}++; + unless ($defseen{$s_symbol}) { + warn "$where: variable '\$$s_symbol' is not listed " . + "on ?MAKE: line.\n" unless $lintseen{$s_symbol}; + $lintseen_used{$s_symbol}++ if $lintseen{$s_symbol}; + } + # Deal with obsolete symbol list (enclosed between parenthesis) + &record_obsolete("\$$_") if /\(/; + } else { + unless ($s_symbol) { + warn "$where: syntax error in ?S: construct.\n"; + return; + } + } + + m|^\.\s*$| && ($s_symbol = ''); # End of comment +} + +# Process the ?C: lines +sub p_c { + local($_) = @_; + local($where) = "\"$file\", line $. (?C:)"; + warn "$where: directive should come after ?MAKE declarations.\n" + unless $makeseen{$unit}; + # The previous ?H: section, if present, must have been closed + if ($h_section && $h_section != 2) { + warn "$where: unclosed ?H: section.\n"; + } + $h_section = 0; + if (s/^(\w+)\s*~\s*(\S+)\s*(.*):/$1 $3:/) { + &check_last_declaration; + $c_symbol = $2; # Alias for definition in config.h + # Record symbol definition for further duplicate spotting + $cmaster{$1} .= "$unit " unless $csym{$1}; + print " ?C: $1 ~ $c_symbol\n" if $opt_d; + # Make sure we do not define symbol twice + warn "$where: duplicate description for symbol '$1'.\n" + if $csym{$1}++; + # Deal with obsolete symbol list (enclosed between parenthesis) + &record_obsolete("$_") if /\(/; + } elsif (/^(\w+)\s*(\(.*\))*\s*:/) { + &check_last_declaration; + $c_symbol = $1; + # Record symbol definition for further duplicate spotting + $cmaster{$c_symbol} .= "$unit " unless $csym{$c_symbol}; + print " ?C: $c_symbol\n" if $opt_d; + # Make sure we do not define symbol twice + warn "$where: duplicate description for symbol '$c_symbol'.\n" + if $csym{$c_symbol}++; + # Deal with obsolete symbol list (enclosed between parenthesis) + &record_obsolete("$_") if /\(/; + } else { + unless ($c_symbol) { + warn "$where: syntax error in ?C: construct.\n"; + return; + } + } + + s|^(\w+)|?$c_symbol:/* $1| || # Start of comment + (s|^\.\s*$|?$c_symbol: */\n| && ($c_symbol = '', 1)) || # End of comment + s|^(.*)|?$c_symbol: *$1|; # Middle of comment +} + +# Process the ?H: lines +sub p_config { + local($_) = @_; + local($where) = "\"$file\", line $. (?H)" unless $where; + warn "$where: directive should come after ?MAKE declarations.\n" + unless $makeseen{$unit}; + unless ($h_section){ # Entering ?H: section + $h_section = 1; + $h_section_warned = 0; + } + if ($h_section == 2) { + warn "$where: section was already terminated by '?H:.'.\n" + unless $h_section_warned++; + return; + } + if ($_ eq ".\n") { + $h_section = 2; # Marks terminated ?H: section + return; + } + (my $constraint) = m/^\?(\w+):/; + s/^\?\w+://; # Remove leading '?var:' constraint + if (m|^#\$(\w+)\s+(\w+).*\$(\w+)|) { + # Case: #$d_var VAR "$var" + warn "$where: symbol '$2' was already defined.\n" if $hcsym{$2}++; + &check_definition("$1"); + &check_definition("$3"); + } elsif (m|^#define\s+(\w+)\((.*)\)\s+\$(\w+)|) { + # Case: #define VAR(x) $var + warn "$where: symbol '$1' was already defined.\n" if $hcsym{$1}++; + &check_definition("$3"); + } elsif (m|^#\$define\s+(\w+)|) { + # Case: #$define VAR + warn "$where: symbol '$1' was already defined.\n" if $hcsym{$1}++; + } elsif (m|^#\$(\w+)\s+(\w+)|) { + # Case: #$d_var VAR + warn "$where: symbol '$2' was already defined.\n" if $hcsym{$2}++; + &check_definition("$1"); + } elsif (m|^#define\s+(\w+).*\$(\w+)|) { + # Case: #define VAR "$var" + warn "$where: symbol '$1' was already defined.\n" if $hcsym{$1}++; + &check_definition("$2"); + } elsif (m|^#define\s+(\w+)|) { + # Case: #define VAR + $hcsym{$1}++; # Multiple occurrences may be legitimate + } else { + if (/^#/) { + warn "$where: uncommon cpp line should be protected with '?%<:'.\n" + if $constraint eq ''; + } elsif (!/^\@(if|elsif|else|end)\b/) { + warn "$where: line should not be listed here but in '?C:'.\n"; + } + } + + # Ensure the constraint is either %< (unit base name) or a known symbol. + if ($constraint ne '' && $constraint ne $unit) { + warn "$where: constraint '$constraint' is an unknown symbol.\n" + unless $csym{$constraint} || $ssym{$constraint}; + } +} + +# Process the ?M: lines +sub p_magic { + local($_) = @_; + local($where) = "\"$file\", line $. (?M)"; + warn "$where: directive should come after ?MAKE declarations.\n" + unless $makeseen{$unit}; + if (/^(\w+):\s*([\w\s]*)\n$/) { + &check_last_declaration; + $m_symbol = $1; + $msym{$1} = "$unit"; # p_wanted ensure we do not define symbol twice + $mdep{$1} = $2; # Save C symbol dependencies + &p_wanted("$unit:$m_symbol"); + } else { + unless ($m_symbol) { + warn "$where: syntax error in ?M: construct.\n"; + return; + } + } + m|^\.\s*$| && ($m_symbol = ''); # End of comment +} + +# Process the ?INIT: lines +sub p_init { + local($_) = @_; + local($where) = "\"$file\", line $. (?INIT)"; + warn "$where: directive should come after ?MAKE declarations.\n" + unless $makeseen{$unit}; + &p_body($_, 1); # Pass it along as a body line (leading ?INIT: removed) +} + +# Process the ?D: lines +sub p_default { + local($_) = @_; + local($where) = "\"$file\", line $. (?D)"; + warn "$where: directive should come after ?MAKE declarations.\n" + unless $makeseen{$unit}; + local($sym) = /^(\w+)=/; + $hasdefault{$sym}++; + unless ($defseen{$sym}) { + warn "$where: variable '\$$sym' is not listed " . + "on ?MAKE: line.\n" unless $lintseen{$sym}; + $lintseen_used{$sym}++ if $lintseen{$sym}; + } + s/^\w+=//; # So that p_body does not consider variable as being set + &p_body($_, 1); # Pass it along as a body line (leading ?D: + var removed) +} + +# Process the ?V: lines +sub p_visible { + local($where) = "\"$file\", line $. (?V)"; + warn "$where: directive should come after ?MAKE declarations.\n" + unless $makeseen{$unit}; + + # A visible symbol can freely be manipulated by any unit which includes the + # current unit in its dependencies. Symbols before ':' may be only used for + # reading while symbols after ':' may be used for both reading and writing. + # The array %shvisible records symbols as keys. Read-only symbols have a + # leading '$' while read-write symbols are recorded as-is. + + unless (substr($unit, 0, 1) =~ /^[A-Z]/) { + warn "$where: visible declaration in non-special unit ignored.\n"; + return; + } + local($read_only) = $_[0] =~ /^([^:]*):?/; + local($read_write) = $_[0] =~ /:(.*)/; + local(@rsym) = split(' ', $read_only); + local(@rwsym) = split(' ', $read_write); + local($w); + foreach (@rsym) { # Read only symbols + warn "$where: wanted variable '\$$_' made visible.\n" if &wanted($_); + warn "$where: defined variable '\$$_' made visible.\n" + if &defined($_) && !$lintseen{$_}; + $w = $shvisible{"\$$_"}; + warn "$where: variable '\$$_' already made visible by unit $w.\n" if $w; + $w = $shvisible{$_}; + warn "$where: variable '\$$_' already read-write visible in $w.\n" if $w; + $shvisible{"\$$_"} = $unit unless $w; + } + foreach (@rwsym) { # Read/write symbols + warn "$where: wanted variable '\$$_' made visible.\n" if &wanted($_); + warn "$where: defined variable '\$$_' made visible.\n" + if &defined($_) && !$lintseen{$_}; + $w = $shvisible{$_}; + warn "$where: variable '\$$_' already made visible by unit $w.\n" if $w; + $w = $shvisible{"\$$_"}; + warn "$where: variable '\$$_' already read-only visible in $w.\n" if $w; + $shvisible{$_} = $unit unless $w; + } +} + +# Process the ?W: lines +sub p_wanted { + local($where) = "\"$file\", line $. (?W)" unless $where; + warn "$where: directive should come after ?MAKE declarations.\n" + unless $makeseen{$unit}; + # Somehow, we should check that none of the symbols to activate are stale + # ones, i.e. they all finally resolve to some known target -- FIXME + local($active) = $_[0] =~ /^([^:]*):/; # Symbols to activate + local($look_symbols) = $_[0] =~ /:(.*)/; # When those are used + local(@symbols) = split(' ', $look_symbols); + # A "?W:symbol" line asks metaconfig to define 'symbol' in the wanted file + # as a C target iff that word is found within the sources. This is mainly + # intended for the built-in interpreter to check for definedness. + local($w); + foreach (@symbols) { + warn "$where: variable '\$$_' already wanted.\n" if &wanted($_); + warn "$where: variable '\$$_' also locally defined.\n" if &defined($_); + $w = $cwanted{$_}; + if ($msym{$_} ne '') { + warn "$where: symbol '$_' already listed on a ?M: line in '$w'.\n" + if $w; + } else { + warn "$where: variable '\$$_' already listed on a ?W: line in '$w'.\n" + if $w; + } + $cwanted{$_} = $unit unless $w; + } +} + +# Process the ?Y: lines +sub p_layout { + local($where) = "\"$file\", line $. (?Y)"; + warn "$where: directive should come after ?MAKE declarations.\n" + unless $makeseen{$unit}; + local($_) = @_; + chop; + s/^\s+//; + tr/A-Z/a-z/; # Layouts are record in lowercase + warn "$where: unknown layout directive '$_'.\n" + unless defined $Lcmp{$_}; +} + +# Process the ?P: lines +sub p_public { + # FIXME +} + +# Process the ?L: lines +sub p_library { + # There should not be any '-l' in front of the library name + # FIXME +} + +# Process the ?I: lines +sub p_include { + # FIXME +} + +# Process the ?T: lines +sub p_temp { + local($where) = "\"$file\", line $. (?T:)"; + warn "$where: directive should come after ?MAKE declarations.\n" + unless $makeseen{$unit}; + local($_) = @_; + local(@sym) = split(' ', $_); + foreach $sym (@sym) { + warn "$where: temporary symbol '\$$sym' multiply declared.\n" + if $tempseen{$sym}++ == 1; + $tempmaster{$sym} .= "$unit " if $tempseen{$sym} == 1; + } +} + +# Process the ?F: lines +sub p_file { + local($where) = "\"$file\", line $. (?F:)"; + warn "$where: directive should come after ?MAKE declarations.\n" + unless $makeseen{$unit}; + local($_) = @_; + local(@files) = split(' ', $_); + local($uufile); # Name of file produced in the UU directory + local($tmpfile); # Name of a temporary file + # We care only about UU files, i.e. files produced in the UU directory + # and which are identified by the convention ./filename. Files !filename + # are not produced, i.e. they are temporary or externally provided. + # The %prodfile table records all the files produced, so we may detect + # inconsistencies between units, while %filemaster records the (first) unit + # defining a given UU file to make sure that (special) unit is named in the + # dependency line when that UU file if used. Duplicates will be caught in + # the sanity check phase thanks to %prodfile. + # Temporary files are recorded in %filesetin, so that we may later compare + # the list with the UU files to detect possible overwrites. + my $is_special = substr($unit, 0, 1) =~ /^[A-Z]/; + foreach $file (@files) { + warn "$where: produced file '$file' multiply declared.\n" + if $fileseen{$file}++ == 1; + if (($tmpfile = $file) =~ s/^!//) { + $filetmp{$tmpfile} = 'x '; + $filesetin{$tmpfile} .= "$unit " if $fileseen{$file} == 1; + next; # Is not a UU file for sure, so skip + } + $prodfile{$file} .= "$unit " if $fileseen{$file} == 1; + ($uufile = $file) =~ s|^\./(\S+)$|$1|; + next if $file eq $uufile; # Don't care about non-UU files + unless ($is_special || $lintcreated{$uufile}) { + warn "$where: UU file '$uufile' in non-special unit ignored.\n"; + delete $lintcreated{$uufile}; # Detect spurious LINT + next; + } + delete $lintcreated{$uufile} if !$is_special; # Detect spurious LINT + $filemaster{$uufile} = $unit unless defined $filemaster{$uufile}; + $filecreated{$uufile} = 'a'; # Will be automagically incremented + } +} + +# Process the ?LINT: lines +sub p_lint { + local($_) = @_; + local(@sym); + local($where) = "\"$file\", line $. (?LINT:)"; + s/^\s+//; # Strip leading spaces + unless ($makeseen{$unit}) { + warn "$where: directive should come after ?MAKE declarations.\n" + unless m/^empty/; + } + if (s/^set//) { # Listed variables are set + @sym = split(' ', $_); # Spurious ones will be flagged + foreach (@sym) { + $lintset{$_}++; # Shell variable set + } + } elsif (s/^desc\w+//) { # Listed shell variables are described + @sym = split(' ', $_); # Spurious ones will be flagged + foreach (@sym) { + $lintsdesc{$_}++; # Shell variable described + } + } elsif (s/^creat\w+//) { # Listed created files in regular units + @sym = split(' ', $_); + foreach (@sym) { + $lintcreated{$_}++; # Persistent UU file created + } + } elsif (s/^known//) { # Listed C variables are described + @sym = split(' ', $_); # Spurious ones will be flagged + foreach (@sym) { + $lintcdesc{$_}++; # C symbol described + } + } elsif (s/^change//) { # Shell variable ok to be changed + @sym = split(' ', $_); # Spurious ones will be flagged + foreach (@sym) { + $lintchange{$_}++; # Do not complain if changed + } + } elsif (s/^extern//) { # Variables known to be externally defined + @sym = split(' ', $_); + foreach (@sym) { + $lintextern{$_}++; # Do not complain if used in a ?H: line + } + } elsif (s/^usefile//) { # Files marked as being used + @sym = split(' ', $_); + foreach (@sym) { + $lintfused{$_}++; + } + } elsif (s/^use//) { # Variables declared as used by unit + @sym = split(' ', $_); # Spurious ones will be flagged + foreach (@sym) { + $lintuse{$_}++; # Do not complain if on ?MAKE and not used + } + } elsif (s/^def\w+//) { # Listed variables are defined + @sym = split(' ', $_); # Spurious ones will be flagged + foreach (@sym) { + $lintseen{$_}++; # Shell variable defined in this unit + } + } elsif (m/^empty/) { # Empty unit file + $lintempty{$unit}++; + } elsif (m/^unclosed/) { # Unclosed here-documents + @sym = split(' ', $_); + foreach (@sym) { + $linthere{$_}++; + } + } elsif (s/^nothere//) { # Not a here-document name + @sym = split(' ', $_); + foreach (@sym) { + $lintnothere{$_}++; + } + } elsif (s/^nocomment//) { # OK if leading unit ': comment' missing + $lintnocomment{$unit}++; + } else { + local($where) = "\"$file\", line $." unless $where; + local($word) = /^(\w+)/; + warn "$where: unknown LINT request '$word' ignored.\n"; + } +} + +# Process the body of the unit +sub p_body { + return unless $makeseen{$unit}; + local($_, $special) = @_; + local($where) = "\"$file\", line $." unless $where; + # Ensure there is no control line in the body of the unit + local($control) = /^\?([\w\-]+):/; + local($known) = $control ? $Depend{$control} : ""; + warn "$where: control sequence '?$control:' ignored within body.\n" + if $known && !/^\?X:|^\?LINT:/; + if (s/^\?LINT://) { # ?LINT directives allowed within body + $_ .= &complete_line(FILE) if s/\\\s*$//; + &p_lint($_); + } + return if $known; + # First non-special line should be a ': description' line + unless ($special || /^\?/ || /^@/) { + warn "$where: first body line should be a general ': description'.\n" + unless $past_first_line++ || $lintnocomment{$unit} || /^:\s+\w+/; + } + # Ensure ': comment' lines do not hold any meta-character + # We assume ":)" introduces a case statement. + if (/^\s*:/ && !/^\s*:\)/) { + warn "$where: missing space after ':' to make it a comment.\n" + unless /^\s*:\s/; + s/\\.//g; # simplistic ignoring of "escaped" chars + s/".*?"//g; + s/'.*?'//g; + if ($wiped_unit) { + s/<\$\w+>//g; + foreach my $wipe (@wiping) { + s/<$wipe>//g; + } + } + warn "$where: found unquoted meta-character $1 on comment line.\n" + while s/([`()<>;&\{\}\|])//g; + warn "$where: found dangling quote on ':' comment line.\n" if /['"]/; + return; + } + # Ingnore interpreted lines and their continuations + if ($last_interpreted) { + return if /\\$/; # Still part of the interpreted line + $last_interpreted = 0; # End of interpreted lines + return; # This line was the last interpreted + } + # Look for interpreted lines and ignore them + if (/^@/) { + $last_interpreted = /\\$/; # Set flag if line is continued + return; # And skip this line + } + # Detect ending of "here" documents + if ($heredoc ne '' && $_ eq "$heredoc\n") { + $heredoc = ''; # Close here-document + $heredoc_nosubst = 0; + return; + } + # Detect beginning of "here" document + my $began_here = 0; + if ($heredoc eq '') { + if (/<<\s*''/) { + # Discourage it, because we're not processing those... + warn "$where: empty here-document name discouraged.\n"; + } elsif (/<<\s*'([^']+)'/ && !$lintnothere{$1}) { + $heredoc = $1; + $heredoc_nosubst = 1; + $began_here++; + } elsif (/<<\s*(\S+)/ && !$lintnothere{$1}) { + $heredoc = $1; + $began_here++; + } + # Continue, as we need to look for possible ">file" on the same line + # as a possible here document, as in "cat <file". + } else { + return if $heredoc_nosubst; # Completely opaque to interpretation + } + $heredoc_line = $. if $began_here; + + # If we've just entered a here document and we're generating a file + # that is exported by the unit, then we need to monitor the variables + # used to make sure there's no missing dependency. + $heredoc_nosubst = 0 + if $began_here && />>?\s*(\S+)/ && $filemaster{$1} eq $unit; + + # From now on, do all substitutes with ':' since it would be dangerous + # to remove things plain and simple. It could yields false matches + # afterwards... + + my $check_vars = 1; + $check_vars = 0 if $heredoc_nosubst && !$began_here; + + # Record any attempt made to set a shell variable + local($sym); + while ($check_vars && s/(\W?)(\w+)=/$1:/) { + my $before = $1; + $sym = $2; + next unless $before eq '' || $before =~ /["'` \t]/; + next if $sym =~ /^\d+/; # Ignore $1 and friends + $symset{$sym}++; # Shell variable set + # Not part of a $cc -DWHATEVER line and not made nor temporary + unless ($sym =~ /^D/ || &defined($sym)) { + if (&wanted($sym)) { + warn "$where: variable '\$$sym' is changed.\n" + unless $lintchange{$sym}; + $lintchange_used{$sym}++ if $lintchange{$sym}; + } else { + # Record that the variable is set but not listed locally. + if ($shset{$unit} !~ /\b$sym\b/) { + $shset{$unit} .= "$sym " unless $lintchange{$sym}; + $lintchange_used{$sym}++ if $lintchange{$sym}; + } + } + } + } + # Now look at the shell variables used: can be $var or ${var} or ${var: + local($var); + local($line) = $_; + while ($check_vars && s/\$\{?(\w+)[\}:]?/$1/) { + $var = $1; + next if $var =~ /^\d+/; # Ignore $1 and friends + # Record variable as undeclared but do not issue a message right now. + # That variable could be exported via ?V: (as $dflt in Myread) or be + # defined by a special unit (like $inlibc by unit Inlibc). + $shunknown{$unit} .= "$var " unless + $lintextern{$var} || &declared($var) || + $shunknown{$unit} =~ /\b$var\b/; + $shused{$unit} .= "\$$var " unless $shused{$unit} =~ /\$$var\b/; + } + + local($file); + + if ($heredoc ne '' && !$began_here) { + # Still in here-document + # Just look for included files from C programs expected to be local + # in case they missed the special unit that produces these files. + if (s!#(\s*)include(\s+)"([\w.]+)"!!) { + $file = $3; + $fileused{$unit} .= "$file " unless + $filetmp{$file} || $fileused{$unit} =~ /\b$file\b/; + } + return; + } + + # Now look at private files used by the unit (./file or ..../UU/file) + # We look at things like '. ./myread' and `./loc ...` as well as "< file" + $_ = $line; + s/<\S+?>//g; # would set-off our >file or >file + while (s!>>?\s*([^\$/`\s;]+)\s*!: !) { + $file = $1; + next if $file =~ /&\d+/; # skip >&4 and friends + $filecreated{$file}++; + } + # Look for mentions of known temporary files to avoid complaining + # that they were not used. + while (s!\s+(\S+)!!) { + $file = $1; + $filetmp{$file} .= ' used' + if defined $filetmp{$file} && $filetmp{$file} !~ /\bused/; + } +} + +# Called at the end of each unit +sub p_end { + local($last) = @_; # Last processed line + local($where) = "\"$file\""; + + # The ?H: section, if present, must have been closed + if ($h_section && $h_section != 2) { + warn "$where: unclosed ?H: section.\n"; + } + $h_section = 0; # For next unit, which may be empty + + # All opened here-documents must be closed. + if ($heredoc ne '') { + my $q = $heredoc_nosubst ? "'" : ""; + warn "$where: unclosed here-document $q$heredoc$q " . + "started line $heredoc_line.\n" + unless $linthere{$heredoc}; + } + + # Reinitialize for next unit. + $heredoc = ''; + $heredoc_nosubst = 0; + $past_first_line = 0; + $last_interpreted = 0; + + unless ($makeseen{$unit}) { + warn "$where: no ?MAKE: line describing dependencies.\n" + unless $lintempty{$unit}; + return; + } + + # Each unit should end with a blank line. Unfortunately, some units + # may also end with an '@end' request and have the blank line above it. + # Currently, we do not have enough information to correctly diagnose + # whether it is valid or not so just skip it. + # Same thing for U/Obsol_sh.U which ends with a shell comment. + + warn "$where: not ending with a blank line.\n" unless + $last =~ /^\s*$/ || $last =~ /^\@end/ || $last =~ /^#|\?/; + + # For EMACS users. It would be fatal to the Configure script... + warn "$where: last line not ending with a new-line character.\n" + unless $last =~ /\n$/; + + # Make sure every shell symbol described in ?MAKE had a description + foreach $sym (sort keys %defseen) { + unless ($ssym{$sym}) { + warn "$where: symbol '\$$sym' was not described.\n" + unless $lintsdesc{$sym}; + $lintsdesc_used{$sym}++ if $lintsdesc{$sym}; + } + } + # Ensure all the C symbols defined by ?H: lines have a description + foreach $sym (sort keys %hcsym) { + unless ($csym{$sym}) { + warn "$where: C symbol '$sym' was not described.\n" + unless $lintcdesc{$sym}; + $lintcdesc_used{$sym}++ if $lintcdesc{$sym}; + } + } + # Ensure all the C symbols described by ?C: lines are defined in ?H: + foreach $sym (sort keys %csym) { + warn "$where: C symbol '$sym' was not defined by any ?H: line.\n" + unless $hcsym{$sym}; + } + # Make sure each defined symbol was set, unless it starts with an + # upper-case letter in which case it is not a "true" shell symbol. + # I don't care about the special symbols defined in %Except as I know + # they are handled correctly. + foreach $sym (sort keys %defseen) { + unless ($symset{$sym} || substr($sym, 0, 1) =~ /^[A-Z]/) { + warn "$where: variable '\$$sym' should have been set.\n" + unless $lintset{$sym}; + $lintset_used{$sym}++ if $lintset{$sym}; + } + } + # Make sure every non-special unit declared as wanted is indeed needed + foreach $sym (sort keys %depseen) { + if ($shused{$unit} !~ /\$$sym\b/ && substr($sym, 0, 1) !~ /^[A-Z]/) { + warn "$where: unused dependency variable '\$$sym'.\n" unless + $lintchange{$sym} || $lintuse{$sym}; + $lintchange_used{$sym}++ if $lintchange{$sym}; + $lintuse_used{$sym}++ if $lintuse{$sym}; + } + } + # Idem for conditionally wanted symbols + foreach $sym (sort keys %condseen) { + if ($shused{$unit} !~ /\$$sym\b/ && substr($sym, 0, 1) !~ /^[A-Z]/) { + warn "$where: unused conditional variable '\$$sym'.\n" unless + $lintchange{$sym} || $lintuse{$sym}; + $lintchange_used{$sym}++ if $lintchange{$sym}; + $lintuse_used{$sym}++ if $lintuse{$sym}; + } + } + # Idem for temporary symbols + foreach $sym (sort keys %tempseen) { + if ($shused{$unit} !~ /\$$sym\b/ && !$symset{$sym}) { + warn "$where: unused temporary variable '\$$sym'.\n" unless + $lintuse{$sym}; + $lintuse_used{$sym}++ if $lintuse{$sym}; + } + } + # Idem for local files + foreach $file (sort keys %filetmp) { + warn "$where: mis-used temporary file '$file'.\n" if + $filetmp{$file} =~ /\bmisused/; + warn "$where: unused temporary file '$file'.\n" unless + $lintfused{$file} || + $filetmp{$file} =~ /\bused/ || $filetmp{$file} =~ /\bmisused/; + } + # Make sure each private file listed as created on ?F: is really created. + # When found, a private UU file is entered in the %filecreated array + # with value 'a'. Each time a file creation occurs in the unit, an + # increment is done on that value. Since 'a'++ -> 'b', a numeric value + # in %filecreated means a non-local file, which is skipped. An 'a' means + # the file was not created... + local($value); + foreach $file (sort keys %filecreated) { + $value = $filecreated{$file}; + next if $value > 0; # Skip non UU-files. + warn "$where: file '$file' was not created.\n" if $value eq 'a'; + } + # Check whether some of the LINT directives were useful + foreach my $sym (sort keys %lintcreated) { + warn "$where: spurious 'LINT create $sym' directive.\n"; + } + foreach my $sym (sort keys %lintuse) { + warn "$where: spurious 'LINT use $sym' directive.\n" + unless $lintuse_used{$sym}; + } + foreach my $sym (sort keys %lintchange) { + warn "$where: spurious 'LINT change $sym' directive.\n" + unless $lintchange_used{$sym}; + } + foreach my $sym (sort keys %lintseen) { + warn "$where: spurious 'LINT define $sym' directive.\n" + unless $lintseen_used{$sym}; + } + foreach my $sym (sort keys %lintsdesc) { + warn "$where: spurious 'LINT describe $sym' directive.\n" + unless $lintsdesc_used{$sym}; + } + foreach my $sym (sort keys %lintcdesc) { + warn "$where: spurious 'LINT known $sym' directive.\n" + unless $lintcdesc_used{$sym}; + } + foreach my $sym (sort keys %lintset) { + warn "$where: spurious 'LINT set $sym' directive.\n" + unless $lintset_used{$sym}; + } +} + +# An unknown control line sequence was found (held in $proc) +sub p_unknown { + warn "\"$file\", line $.: unknown control sequence '?$proc:'.\n"; +} + +# Run sanity checks, to make sure every conditional symbol has a suitable +# default value. Also ensure every symbol was defined once. +sub sanity_checks { + print "Sanity checks...\n"; + local($key, $value); + local($w); + local(%message); # Record messages on a per-unit basis + local(%said); # Avoid duplicate messages + # Warn about symbols ever used in conditional dependency with no default + while (($key, $value) = each(%condsym)) { + unless ($hasdefault{$key}) { + $w = (split(' ', $shmaster{"\$$key"}))[0]; + $message{$w} .= "#$key "; + } + } + # Warn about any undeclared variables. They are all listed in %shunknown, + # being the values while the unit where they appear is the key. If the + # symbol is defined by any of the special units included or made visible, + # then no warning is issued. + local($defined); # True if symbol is defined in one unit + local($where); # List of units where symbol is defined + local($myself); # The name of the current unit if itself special + local($visible); # Symbol made visible via a ?V: line + foreach $unit (sort keys %shunknown) { + foreach $sym (split(' ', $shunknown{$unit})) { + $defined = 0; + $where = $shmaster{"\$$sym"}; + $defined = 1 if $tempmaster{"\$$sym"} =~ /$unit\b/; + $myself = substr($unit, 0, 1) =~ /^[A-Z]/ ? $unit : ''; + # Symbol has to be either defined within one of the special units + # listed in the dependencies or exported via a ?V: line. + unless ($defined) { + $defined = &visible($sym, $unit); + $spneeded{$unit}++ if $defined; + } + $message{$unit} .= "\$$sym " unless $defined; + } + } + + # Warn about any undeclared files. Files used in one unit are all within + # the %fileused table, indexed by unit. If a file is used, it must either + # be in the unit that declared it (relying on %filemaster for that) or + # the unit listed in %filemaster must be part of our dependency. + %said = (); + foreach $unit (sort keys %fileused) { + foreach $file (split(' ', $fileused{$unit})) { + $defined = 0; + $where = $filemaster{$file}; # Where file is created + $defined = 1 if $unit eq $where; # We're in the unit defining it + # Private UU files may be only be created by special units + foreach $special (split(' ', $shspecial{$unit})) { + last if $defined; + $defined = 1 if $where eq $special; + } + # Exceptions to above rule possible via a ?LINT:create hint, + # so parse all known dependencies for the unit... + foreach $depend (split(' ', $shdepend{$unit})) { + last if $defined; + $defined = 1 if $where eq $depend; + } + $message{$unit} .= "\@$file " unless + $defined || $said{"$unit/$file"}++; # Unknown file + } + } + undef %fileused; + + # Warn about any misused files, kept in %filemisused + foreach $unit (sort keys %filemisused) { + foreach $file (split(' ', $filemisused{$unit})) { + next unless defined $filemaster{$file}; # Skip non UU-files + $message{$unit} .= "\@\@$file "; # Misused file + } + } + undef %filemisused; + + # Warn about temporary files which could be created and inadvertently + # override a private UU file (listed in %filemaster). + foreach $tmpfile (keys %filesetin) { + next unless defined $filemaster{$tmpfile}; + $where = $filemaster{$tmpfile}; + foreach $unit (split(' ', $filesetin{$tmpfile})) { + $message{$unit} .= "\@\@\@$where:$tmpfile "; + } + } + undef %filesetin; + + # Warn about any set variable which was not listed. + foreach $unit (sort keys %shset) { + symbol: foreach $sym (split(' ', $shset{$unit})) { + next if $shvisible{$sym}; + $defined = 0; + # Symbol has to be either defined within one of the special units + # listed in the dependencies or exported read-write via a ?V: line. + # If symbol is exported read-only, report the attempt to set it. + $where = $shmaster{"\$$sym"}; + study $where; + foreach $special (split(' ', $shspecial{$unit})) { + $defined = 1 if $where =~ /\b$special\b/; + last if $defined; + } + $visible = 0; + $defined = $visible = &visible($sym, $unit) unless $defined; + if ($visible && $shvisible{"\$$sym"} ne '') { + # We are allowed to set a read-only symbol in the unit which + # declared it... + next symbol if $shvisible{"\$$sym"} eq $unit; + $message{$unit} .= "\&$sym "; # Read-only symbol set + next symbol; + } + $message{$unit} .= "$sym " unless $defined; + } + } + # Warn about any obsolete variable which may be used + foreach $unit (sort keys %shused) { + foreach $sym (split(' ', $shused{$unit})) { + $message{$unit} .= "!$sym " if $Obsolete{$sym} ne ''; + } + } + + # Warn about stale dependencies, and prepare successor and predecessor + # tables for later topological sort. + + local($targets, $deps); + local(%Succ); # Successors + local(%Prec); # Predecessors + + # Split dependencies and build successors array. + foreach $make (@make) { + ($targets, $deps) = $make =~ m|(.*):\s*(.*)|; + $deps =~ s/\+(\w)/$1/g; # Remove conditional targets + foreach $target (split(' ', $targets)) { + $Succ{$target} .= $deps . ' '; + } + } + + # Special setup for the End target, which normally has a $W dependency for + # wanted symbols. In order to detect all the possible cycles, we forge a + # huge dependency by making ALL the regular symbols (i.e. those whose first + # letter is not uppercased) wanted. + + local($allwant) = ''; + { + local($sym, $val); + while (($sym, $val) = each %shmaster) { + $sym =~ s/^\$//; + $allwant .= "$sym " if $val ne ''; + } + } + + $Succ{'End'} =~ s/\$W/$allwant/; + + # Initialize precursors, and spot symbols impossible to 'make', i.e. those + # symbols listed in the successors and with no 'make' target. The data + # structures %Prec and %Succ will also be used by the cycle lookup code, + # in other words, the topological sort. + foreach $target (keys %Succ) { + $Prec{$target} += 0; # Ensure key is recorded without disturbing. + foreach $succ (split(' ', $Succ{$target})) { + $Prec{$succ}++; # Successor has one more precursor + unless (defined $Succ{$succ} || $said{$succ}++) { + foreach $unit (split(' ', $symdep{$succ})) { + $message{$unit} .= "?$succ "; # Stale ?MAKE: dependency + } + } + } + } + undef %symdep; + + # Check all ?M: dependencies to spot stale ones + %said = (); + while (($key, $value) = each(%msym)) { + next if $value eq ''; # Value is unit name where ?M: occurred + foreach $sym (split(' ', $mdep{$key})) { # Loop on C dependencies + next if $cmaster{$sym} || $said{$sym}; + $message{$value} .= "??$sym "; # Stale ?M: dependency + $said{$sym}++; + } + } + + undef %said; + undef %mdep; + undef %msym; + + # Now actually emit all the warnings + local($uv); # Unit defining visible symbol or private file + local($w); # Were we are signaling an error + foreach $unit (sort keys %message) { + undef %said; + $w = "\"$unit.U\""; + foreach (split(' ', $message{$unit})) { + if (s/^#//) { + warn "$w: symbol '\$$_' has no default value.\n"; + } elsif (s/^\?\?//) { + warn "$w: stale ?M: dependency '$_'.\n"; + } elsif (s/^\?//) { + warn "$w: stale ?MAKE: dependency '$_'.\n"; + } elsif (s/^\$//) { + if ($shmaster{"\$$_"} ne '') { + warn "$w: symbol '\$$_' missing from ?MAKE.\n"; + } elsif (($uv = $shvisible{$_}) ne '') { + warn "$w: missing $uv from ?MAKE for visible '\$$_'.\n"; + } elsif (($uv = $shvisible{"\$$_"}) ne '') { + warn "$w: missing $uv from ?MAKE for visible '\$$_'.\n"; + } else { + warn "\"$unit.U\": unknown symbol '\$$_'.\n"; + } + ++$said{$_}; + } elsif (s/^\&//) { + warn "\"$unit.U\": read-only symbol '\$$_' is set.\n"; + ++$said{$_}; + } elsif (s/^!//) { + warn "\"$unit.U\": obsolete symbol '$_' is used.\n"; + ++$said{$_}; + } elsif (s/^\@\@\@//) { + $uv = '?'; # To spot format errors + s/^(\w+):// && ($uv = $1); + warn "$w: local file '$_' may override the one set by $uv.U.\n"; + } elsif (s/^\@\@//) { + $uv = $filemaster{$_}; + warn "$w: you might not always get file '$_' from $uv.U.\n"; + } elsif (s/^\@//) { + if ($uv = $filemaster{$_}) { + warn "$w: missing $uv from ?MAKE for private file '$_'.\n"; + } else { + warn "$w: unknown private file '$_'.\n"; + } + ++$said{"\@$_"}; + } else { + warn "\"$unit.U\": undeclared symbol '\$$_' is set.\n" + unless $said{$_}; + } + } + } + + # Memory cleanup + undef %message; + undef %said; + undef %shused; + undef %shset; + undef %shspecial; + undef %shvisible; + undef %filemaster; + + # Spot multiply defined C symbols + foreach $sym (keys %cmaster) { + @sym = split(' ', $cmaster{$sym}); + if (@sym > 1) { + warn "C symbol '$sym' is defined in the following units:\n"; + foreach (@sym) { + print STDERR "\t$_.U\n"; + } + } + } + undef %cmaster; # Memory cleanup + + # Warn about multiply defined symbols. There are three kind of symbols: + # target symbols, obsolete symbols and temporary symbols. + # For each of these sets, we make sure the intersection with the other sets + # is empty. Besides, we make sure target symbols are only defined once. + + local(@sym); + foreach $sym (keys %shmaster) { + @sym = split(' ', $shmaster{$sym}); + if (@sym > 1) { + warn "Shell symbol '$sym' is defined in the following units:\n"; + foreach (@sym) { + print STDERR "\t$_.U\n"; + } + } + $message{$sym} .= 'so ' if $Obsolete{$sym}; + $message{$sym} .= 'st ' if $tempmaster{$sym}; + } + foreach $sym (keys %tempmaster) { + $message{$sym} .= 'ot ' if $Obsolete{$sym}; + } + local($_); + while (($sym, $_) = each %message) { + if (/so/) { + if (/ot/) { + warn "Shell symbol '$sym' is altogether:\n"; + @sym = split(' ', $shmaster{$sym}); + @sym = grep(s/$/.U/, @sym); + print STDERR "...defined in: ", join(', ', @sym), "\n"; + print STDERR "...obsoleted by $Obsolete{$sym}.\n"; + @sym = split(' ', $tempmaster{$sym}); + @sym = grep(s/$/.U/, @sym); + print STDERR "...used as temporary in:", join(', ', @sym), "\n"; + } else { + warn "Shell symbol '$sym' is both defined and obsoleted:\n"; + @sym = split(' ', $shmaster{$sym}); + @sym = grep(s/$/.U/, @sym); + print STDERR "...defined in: ", join(', ', @sym), "\n"; + print STDERR "...obsoleted by $Obsolete{$sym}.\n"; + } + } elsif (/st/) { # Cannot be ot as it would imply so + warn "Shell symbol '$sym' is both defined and used as temporary:\n"; + @sym = split(' ', $shmaster{$sym}); + @sym = grep(s/$/.U/, @sym); + print STDERR "...defined in: ", join(', ', @sym), "\n"; + @sym = split(' ', $tempmaster{$sym}); + @sym = grep(s/$/.U/, @sym); + print STDERR "...used as temporary in:", join(', ', @sym), "\n"; + } elsif (/ot/) { + warn "Shell symbol '$sym' obsoleted also used as temporary:\n"; + print STDERR "...obsoleted by $Obsolete{$sym}.\n"; + @sym = split(' ', $tempmaster{$sym}); + @sym = grep(s/$/.U/, @sym); + print STDERR "...used as temporary in:", join(', ', @sym), "\n"; + } + } + + # Spot multiply defined files, either private or public ones + foreach $file (keys %prodfile) { + @sym = split(' ', $prodfile{$file}); + if (@sym > 1) { + warn "File '$file' is defined in the following units:\n"; + foreach (@sym) { + print STDERR "\t$_\n"; + } + } + } + undef %prodfile; + + + # Memory cleanup (we still need %shmaster for tsort) + undef %message; + undef %tempmaster; + undef %Obsolete; + + # Make sure there is no dependency cycle + print "Looking for dependency cycles...\n"; + &tsort(*Succ, *Prec); # Destroys info from %Prec +} + +# Make sure last declaration ended correctly with a ?S:. or ?C:. line. +# The variable '$where' was correctly positionned by the calling routine. +sub check_last_declaration { + warn "$where: definition of '\$$s_symbol' not closed by '?S:.'.\n" + if $s_symbol ne ''; + warn "$where: definition of '$c_symbol' not closed by '?C:.'.\n" + if $c_symbol ne ''; + warn "$where: magic definition of '$m_symbol' not closed by '?M:.'.\n" + if $m_symbol ne ''; + $s_symbol = $c_symbol = $m_symbol = ''; +} + +# Make sure the variable is mentionned on the ?MAKE line, if possible in the +# definition section. +# The variable '$where' was correctly positionned by the calling routine. +sub check_definition { + local($var) = @_; + warn "$where: variable '\$$var' not even listed on ?MAKE: line.\n" + unless $defseen{$var} || $condseen{$var} || $depseen{$var}; + warn "$where: variable '\$$var' is defined externally.\n" + if !$lintextern{$var} && !$defseen{$var} && &wanted($var); +} + +# Is symbol declared somewhere? +sub declared { + &defined($_[0]) || &wanted($_[0]); +} + +# Is symbol defined by unit? +sub defined { + $tempseen{$_[0]} || $defseen{$_[0]} || $lintseen{$_[0]}; +} + +# Is symbol wanted by unit? +sub wanted { + $depseen{$_[0]} || $condseen{$_[0]}; +} + +# Is symbol visible from the unit? +# Locate visible symbols throughout the special units. Each unit having +# some special dependencies (special units wanted) have an entry in the +# %shspecial array, listing all those special dependencies. And each +# symbol made visible by ONE special unit has an entry in the %shvisible +# array. +sub visible { + local($symbol, $unit) = @_; + local(%explored); # Special units we've already explored + &explore($symbol, $unit); # Perform recursive search +} + +# Recursively explore the dependencies to locate a visible symbol +sub explore { + local($symbol, $unit) = @_; + # If unit was already explored, we know it has not been found by following + # that path. + return 0 if defined $explored{$unit}; + $explored{$unit} = 0; # Assume nothing found in this unit + local($specials) = $shspecial{$unit}; + # Don't waste any time if unit does not have any special units listed + # in its dependencies. + return 0 unless $specials; + foreach $special (split(' ', $specials)) { + return 1 if ( + $shvisible{"\$$symbol"} eq $unit || + $shvisible{$symbol} eq $unit || + &explore($symbol, $special) + ); + } + 0; +} + diff --git a/mcon/pl/locate.pl b/mcon/pl/locate.pl new file mode 100644 index 0000000..46c1078 --- /dev/null +++ b/mcon/pl/locate.pl @@ -0,0 +1,153 @@ +;# $Id$ +;# +;# Copyright (c) 1991-1997, 2004-2006, Raphael Manfredi +;# +;# You may redistribute only under the terms of the Artistic Licence, +;# as specified in the README file that comes with the distribution. +;# You may reuse parts of this distribution only within the terms of +;# that same Artistic Licence; a copy of which may be found at the root +;# of the source tree for dist 4.0. +;# +;# $Log: locate.pl,v $ +;# Revision 3.0.1.1 1994/10/29 16:36:52 ram +;# patch36: misspelled a 'closedir' as a 'close' statement +;# +;# Revision 3.0 1993/08/18 12:10:25 ram +;# Baseline for dist 3.0 netwide release. +;# +;# +;# Locate units and put them in the @ARGV array, for later perusal. We first +;# look in the private U directory, then in the public U library. In each U +;# directory, units may be gathered in clusters (directories). These clusters +;# should not have a name ending with .U, as those will never be stat()'ed. +;# +;# NB: Currently, the clusters are only a practical way of grouping a set of +;# closely related units. There must not be any name conflicts. +;# +;# The following variables are used: +;# $WD is assumed to be the working directory (where the process was spawned) +;# $MC is the location of metaconfig's public library +;# @ARGV is the list of all the units full path +;# %Unit maps an unit name (without final .U) to a path +;# @myUlist lists the user's units, which will be appended at the end of @ARGV +;# %myUseen lists the user's units which overwrite public ones +;# +package locate; + +# Locate the units and push their path in @ARGV (sorted alphabetically) +sub main'locate_units { + print "Locating units...\n" unless $main'opt_s; + local(*WD) = *main'WD; # Current working directory + local(*MC) = *main'MC; # Public metaconfig library + undef %myUlist; # Records private units paths + undef %myUseen; # Records private/public conflicts + &private_units; # Locate private units in @myUlist + &public_units; # Locate public units in @ARGV + @ARGV = sort @ARGV; # Sort it alphabetically + push(@ARGV, sort @myUlist); # Append user's units sorted + &dump_list if $main'opt_v; # Dump the list of units +} + +# Dump the list of units on stdout +sub dump_list { + print "\t"; + $, = "\n\t"; + print @ARGV; + $, = ''; + print "\n"; +} + +# Scan private units +sub private_units { + return unless -d 'U'; # Nothing to be done if no 'U' entry + local(*ARGV) = *myUlist; # Really fill in @myUlist + local($MC) = $WD; # We are really in the working directory + &units_path("U"); # Locate units in the U directory + local($unit_name); # Unit's name (without .U) + local(@kept); # Array of kept units + # Loop over the units and remove duplicates (the first one seen is the one + # we keep). Also set the %myUseen H table to record private units seen. + foreach (@ARGV) { + ($unit_name) = m|^.*/(.*)\.U$|; # Get unit's name from path + next if $myUseen{$unit_name}; # Already recorded + $myUseen{$unit_name} = 1; # Record pirvate unit + push(@kept, $_); # Keep this unit + } + @ARGV = @kept; +} + +# Scan public units +sub public_units { + chdir($MC) || die "Can't find directory $MC.\n"; + &units_path("U"); # Locate units in public U directory + chdir($WD) || die "Can't go back to directory $WD.\n"; + local($path); # Relative path from $WD + local($unit_name); # Unit's name (without .U) + local(*Unit) = *main'Unit; # Unit is a global from main package + local(@kept); # Units kept + local(%warned); # Units which have already issued a message + # Loop over all the units and keep only the ones that were not found in + # the user's U directory. As it is possible two or more units with the same + # name be found in + foreach (@ARGV) { + ($unit_name) = m|^.*/(.*)\.U$|; # Get unit's name from path + next if $warned{$unit_name}; # We have already seen this unit + $warned{$unit_name} = 1; # Remember we have warned the user + if ($myUseen{$unit_name}) { # User already has a private unit + $path = $Unit{$unit_name}; # Extract user's unit path + next if $path eq $_; # Same path, we must be in mcon/ + $path =~ s|^$WD/||o; # Weed out leading working dir path + print " Your private $path overrides the public one.\n" + unless $main'opt_s; + } else { + push(@kept, $_); # We may keep this one + } + } + @ARGV = @kept; +} + +# Recursively locate units in the directory. Each file ending with .U has to be +# a unit. Others are stat()'ed, and if they are a directory, they are also +# scanned through. The $MC and @ARGV variable are dynamically set by the caller. +sub units_path { + local($dir) = @_; # Directory where units are to be found + local(@contents); # Contents of the directory + local($unit_name); # Unit's name, without final .U + local($path); # Full path of a unit + local(*Unit) = *main'Unit; # Unit is a global from main package + unless (opendir(DIR, $dir)) { + warn("Cannot open directory $dir.\n"); + return; + } + print "Locating in $MC/$dir...\n" if $main'opt_v; + @contents = readdir DIR; # Slurp the whole thing + closedir DIR; # And close dir, ready for recursion + foreach (sort @contents) { + next if $_ eq '.' || $_ eq '..'; + if (/\.U$/) { # A unit, definitely + ($unit_name) = /^(.*)\.U$/; + $path = "$MC/$dir/$_"; # Full path of unit + push(@ARGV, $path); # Record its path + if (defined $Unit{$unit_name}) { # Already seen this unit + if ($main'opt_v) { + ($path) = $Unit{$unit_name} =~ m|^(.*)/.*|; + print " We've already seen $unit_name.U in $path.\n"; + } + } else { + $Unit{$unit_name} = $path; # Map name to path + } + next; + } + # We have found a file which does not look like a unit. If it is a + # directory, then scan it. Otherwise skip the file. + unless (-d "$dir/$_") { + print " Skipping file $_ in $dir.\n" if $main'opt_v; + next; + } + &units_path("$dir/$_"); + print "Back to $MC/$dir...\n" if $main'opt_v; + } +} + +package main; + diff --git a/mcon/pl/makefile.pl b/mcon/pl/makefile.pl new file mode 100644 index 0000000..434fbeb --- /dev/null +++ b/mcon/pl/makefile.pl @@ -0,0 +1,172 @@ +;# $Id$ +;# +;# Copyright (c) 1991-1997, 2004-2006, Raphael Manfredi +;# +;# You may redistribute only under the terms of the Artistic Licence, +;# as specified in the README file that comes with the distribution. +;# You may reuse parts of this distribution only within the terms of +;# that same Artistic Licence; a copy of which may be found at the root +;# of the source tree for dist 4.0. +;# +;# $Log: makefile.pl,v $ +;# Revision 3.0.1.1 1995/09/25 09:19:42 ram +;# patch59: symbols are now sorted according to the ?Y: layout directive +;# +;# Revision 3.0 1993/08/18 12:10:26 ram +;# Baseline for dist 3.0 netwide release. +;# +;# +;# Given a list of wanted symbols in the Wanted file, produce a Makefile which +;# will compute the transitive closure of dependencies for us and give the +;# correct layout order in the Configure script. Because some conditional +;# symbols could indeed be truly wanted symbols, we build the makefile in two +;# passes. The first one will give us the complete list of units to be loaded, +;# while the second will determine the correct order. +;# +;# The external $saved_dependencies records the original dependencies we got +;# from the units' ?MAKE: lines while $dependencies is tampered with. +;# +;# Note that when the -w option is supplied, the sources are not parsed. +;# However, the config.h.SH file would be empty, because its building +;# relies on values in cmaster and shmaster arrays. It is okay for values +;# in shmaster, because they are true wanted symbols. The cmaster keys +;# have also been written, but with a leading '>' (because they are +;# not true targets for Makefile). We thus extract all these keys and +;# set the cmaster array accordingly. +;# +;# Obsolete symbols, if any found, are also part of the Wanted file, written on +;# a line starting with a '!', eventually followed by a '>' if the obsolete +;# symbol is a C one. +;# +;# These three data structures record wanted things like commands or symbols. +;# %symwanted{'sym'} is true when the symbol is wanted (transitive closure) +;# %condwanted{'sym'} when the default value of a symbol is requested +;# $wanted records the set of wanted shell symbols (as opposed to C ones) +;# +# Build the private makefile we use to compute the transitive closure of the +# previously determined dependencies. +sub build_makefile { + print "Computing optimal dependency graph...\n" unless $opt_s; + chdir('.MT') || die "Can't chdir to .MT\n"; + local($wanted); # Wanted shell symbols + &build_private; # Build a first makefile from dependencies + &compute_loadable; # Compute loadable units + &update_makefile; # Update makefile using feedback from first pass + chdir($WD) || die "Can't chdir back to $WD\n"; + # Free memory by removing useless data structures + undef $dependencies; + undef $saved_dependencies; +} + +# First pass: build a private makefile from the extracted dependency, changing +# conditional units to truly wanted ones if the symbol is used, removing the +# dependency otherwise. The original dependencies are saved. +sub build_private { + print " Building private make file...\n" unless $opt_s; + open(WANTED,"../Wanted") || die "Can't reopen Wanted.\n"; + $wanted = ' ' x 2000; # Pre-extend string + $wanted = ''; + while () { + chop; + next if /^!/; # Skip obsolete symbols + if (s/^>//) { + $cmaster{$_}++; + } else { + $wanted .= "$_ "; + } + } + close WANTED; + + # The wanted symbols are sorted so that d_* (checking for C library symbol) + # come first and i_* (checking for includes) comes at the end. Grouping the + # d_* symbols together has good chances of improving the locality of the + # other questions and i_* symbols must come last since some depend on h_* + # values which prevent incompatible headers inclusions. + $wanted = join(' ', sort symbols split(' ', $wanted)); + + # Now generate the first makefile, which will be used to determine which + # symbols we really need, so that conditional dependencies may be solved. + open(MAKEFILE,">Makefile") || die "Can't create .MT/Makefile.\n"; + print MAKEFILE "SHELL = /bin/sh\n"; + print MAKEFILE "W = $wanted\n"; + $saved_dependencies = $dependencies; + foreach $sym (@Cond) { + if ($symwanted{$sym}) { + $dependencies =~ s/\+($sym\s)/$1/gm; + } else { + $dependencies =~ s/\+$sym(\s)/$1/gm; + } + } + print MAKEFILE $dependencies; + close MAKEFILE; +} + +# Ordering for symbols. Give higher priority to d_* ones and lower to i_* ones. +# If any layout priority is defined in %Layout, it is used to order the +# symbols. +sub symbols { + local($r) = $Layout{$a} <=> $Layout{$b}; + return $r if $r; + # If we come here, both symbols have the same layout priority. + if ($a =~ /^d_/) { + return -1 unless $b =~ /^d_/; + } elsif ($b =~ /^d_/) { + return 1; + } elsif ($a =~ /^i_/) { + return 1 unless $b =~ /^i_/; + } elsif ($b =~ /^i_/) { + return -1; + } + $a cmp $b; +} + +# Run the makefile produced in the first pass to find the whole set of units we +# have to load, filling in the %symwanted and %condwanted structures. +sub compute_loadable { + print " Determining loadable units...\n" unless $opt_s; + open(MAKE, "make -n |") || die "Can't run make"; + while () { + s|^\s+||; # Some make print tabs before command + if (/^pick/) { + print "\t$_" if $opt_v; + ($pick,$cmd,$symbol,$unit) = split(' '); + $symwanted{$symbol}++; + $symwanted{$unit}++; + } elsif (/^cond/) { + print "\t$_" if $opt_v; + ($pick,@symbol) = split(' '); + for (@symbol) { + $condwanted{$_}++; # Default value is requested + } + } + } + close MAKE; +} + +# Now that we know all the desirable symbols, we have to rebuild +# another makefile, in order to have the units in a more optimal +# way. +# Actually, if we have both ?MAKE:a:+b and ?MAKE:d:b and 'd' is +# wanted; then 'b' will be loaded. However, 'b' is a conditional +# dependency for 'a', and it would be better if 'b' were loaded +# before 'a' is, though this is not necessary. +# It is hard to know that 'b' will be loaded *before* the first make. + +# Back to the original dependencies, make loadable units truly wanted ones and +# remove optional ones. +sub update_makefile { + print " Updating make file...\n" unless $opt_s; + open(MAKEFILE,">Makefile") || die "Can't create .MT/Makefile.\n"; + print MAKEFILE "SHELL = /bin/sh\n"; + print MAKEFILE "W = $wanted\n"; + foreach $sym (@Cond) { + if ($symwanted{$sym}) { + $saved_dependencies =~ s/\+($sym\s)/$1/gm; + } else { + $saved_dependencies =~ s/\+$sym(\s)/$1/gm; + } + } + print MAKEFILE $saved_dependencies; + close MAKEFILE; +} + diff --git a/mcon/pl/obsolete.pl b/mcon/pl/obsolete.pl new file mode 100644 index 0000000..ba9a601 --- /dev/null +++ b/mcon/pl/obsolete.pl @@ -0,0 +1,103 @@ +;# $Id$ +;# +;# Copyright (c) 1991-1997, 2004-2006, Raphael Manfredi +;# +;# You may redistribute only under the terms of the Artistic Licence, +;# as specified in the README file that comes with the distribution. +;# You may reuse parts of this distribution only within the terms of +;# that same Artistic Licence; a copy of which may be found at the root +;# of the source tree for dist 4.0. +;# +;# $Log: obsolete.pl,v $ +;# Revision 3.0.1.1 1995/01/30 14:49:22 ram +;# patch49: random clean-up in &record_obsolete +;# +;# Revision 3.0 1993/08/18 12:10:27 ram +;# Baseline for dist 3.0 netwide release. +;# +;# +;# Deal with obsolete symbols. They are recorded in the %Obsolete array. +;# Optionally, the obsolete symbols may be remaped onto the new ones (option +;# -o), which enables smooth evolution from 2.0. +;# +# Record obsolete symbols association (new versus old), that is to say for a +# given old symbol, $Obsolete{'old'} = new symbol to be used. A '$' is prepended +# for all shell variables +sub record_obsolete { + local($_) = @_; + local(@obsoleted); # List of obsolete symbols + local($symbol); # New symbol which must be used + local($dollar) = s/^\$// ? '$':''; # The '$' or a null string + # Syntax for obsolete symbols specification is + # list of symbols (obsolete ones): + if (/^(\w+)\s*\((.*)\)\s*:$/) { + $symbol = "$dollar$1"; + @obsoleted = split(' ', $2); # List of obsolete symbols + } else { + if (/^(\w+)\s*\((.*):$/) { + warn "\"$file\", line $.: final ')' before ':' missing.\n"; + $symbol = "$dollar$1"; + @obsoleted = split(' ', $2); + } else { + warn "\"$file\", line $.: syntax error.\n"; + return; + } + } + foreach $val (@obsoleted) { + $_ = $dollar . $val; + if (defined $Obsolete{$_}) { + warn "\"$file\", line $.: '$_' already obsoleted by '$Obsolete{$_}'.\n"; + } else { + $Obsolete{$_} = $symbol; # Record (old, new) tuple + } + } +} + +# Dump obsolete symbols used in file 'Obsolete'. Also write Obsol_h.U and +# Obsol_sh.U to record old versus new mappings if the -o option was used. +sub dump_obsolete { + unless (-f 'Obsolete') { + open(OBSOLETE, ">Obsolete") || die "Can't create Obsolete.\n"; + } + open(OBSOL_H, ">.MT/Obsol_h.U") || die "Can't create .MT/Obsol_h.U.\n"; + open(OBSOL_SH, ">.MT/Obsol_sh.U") || die "Can't create .MT/Obsol_sh.U.\n"; + local($file); # File where obsolete symbol was found + local($old); # Name of this old symbol + local($new); # Value of the new symbol to be used + # Leave a blank line at the top so that anny added ^L will stand on a line + # by itself (the formatting process adds a ^L when a new page is needed). + format OBSOLETE_TOP = + + File | Old symbol | New symbol +-----------------------------------+----------------------+--------------------- +. + format OBSOLETE = +@<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< | @<<<<<<<<<<<<<<<<<<< | @<<<<<<<<<<<<<<<<<<< +$file, $old, $new +. + local(%seen); + foreach $key (sort keys %ofound) { + ($file, $old, $new) = ($key =~ /^(\S+)\s+(\S+)\s+(\S+)/); + write(OBSOLETE) unless $file eq 'XXX'; + next unless $opt_o; # Obsolete mapping done only with -o + next if $seen{$old}++; # Already remapped, thank you + if ($new =~ s/^\$//) { # We found an obsolete shell symbol + $old =~ s/^\$//; + print OBSOL_SH "$old=\"\$$new\"\n"; + } else { # We found an obsolete C symbol + print OBSOL_H "#ifdef $new\n"; + print OBSOL_H "#define $old $new\n"; + print OBSOL_H "#endif\n\n"; + } + } + close OBSOLETE; + close OBSOL_H; + close OBSOL_SH; + if (-s 'Obsolete') { + print "*** Obsolete symbols found -- see file 'Obsolete' for a list.\n"; + } else { + unlink 'Obsolete'; + } + undef %ofound; # Not needed any more +} + diff --git a/mcon/pl/order.pl b/mcon/pl/order.pl new file mode 100644 index 0000000..1616beb --- /dev/null +++ b/mcon/pl/order.pl @@ -0,0 +1,42 @@ +;# $Id$ +;# +;# Copyright (c) 1991-1997, 2004-2006, Raphael Manfredi +;# +;# You may redistribute only under the terms of the Artistic Licence, +;# as specified in the README file that comes with the distribution. +;# You may reuse parts of this distribution only within the terms of +;# that same Artistic Licence; a copy of which may be found at the root +;# of the source tree for dist 4.0. +;# +;# $Log: order.pl,v $ +;# Revision 3.0 1993/08/18 12:10:28 ram +;# Baseline for dist 3.0 netwide release. +;# +;# +;# The @cmdwanted array records the output of the makefile (pick commands only). +;# The shell commands are executed right away. +;# @cmdwanted records the output of the make process (solving dependencies) +# Solve dependencies by saving the 'pick' command in @cmdwanted +sub solve_dependencies { + local(%unitseen); # Record already picked units (avoid duplicates) + print "Determining the correct order for the units...\n" unless $opt_s; + chdir('.MT') || die "Can't chdir to .MT: $!.\n"; + open(MAKE, "make -n |") || die "Can't run make"; + while () { + s|^\s+||; # Some make print tabs before command + print "\t$_" if $opt_v; + if (/^pick/) { + ($pick,$cmd,$symbol,$unit) = split(' '); + push(@cmdwanted,"$cmd $symbol $unit") + unless $unitseen{"$cmd:$unit"}++; + } elsif (/^cond/) { + # Ignore conditional symbol request + } else { + chop; + system $_; + } + } + chdir($WD) || die "Can't chdir to $WD: $!.\n"; + close MAKE; +} + diff --git a/mcon/pl/tsort.pl b/mcon/pl/tsort.pl new file mode 100644 index 0000000..4d56fae --- /dev/null +++ b/mcon/pl/tsort.pl @@ -0,0 +1,166 @@ +;# $Id$ +;# +;# Copyright (c) 1991-1997, 2004-2006, Raphael Manfredi +;# +;# You may redistribute only under the terms of the Artistic Licence, +;# as specified in the README file that comes with the distribution. +;# You may reuse parts of this distribution only within the terms of +;# that same Artistic Licence; a copy of which may be found at the root +;# of the source tree for dist 4.0. +;# +;# $Log: tsort.pl,v $ +;# Revision 3.0 1993/08/18 12:10:28 ram +;# Baseline for dist 3.0 netwide release. +;# +;# +;# The topological sort is performed using the following algorithm: +;# +;# We have a list of successors for each item; makefile dependencies of +;# the form 'a b: c d' means successors(a) = successors(b) = { c, d }. +;# From that input, we derive a number of precursors for each item. +;# In our simple example above, c and d both have two precursors and +;# a and b have none. Items with no precursors are called outsiders +;# and are left in a pool. The sort is then initiated and will continue +;# until all the items have been sorted or a cycle is found... +;# +;# Outsiders are ready to be sorted; since the topological sort is a partial +;# order, an external criterion is needed to choose one item among the ones +;# in the pool. That item is assigned a number, and the number of precursors +;# for the remaining items is updated (by following the successors of the +;# sorted item and decrementing the value for each successor). Among those, +;# if any item reaches a precursor count of zero, it becomes an outsider. +;# +;# The algorithm ends when the outsider pool is empty. If it becomes empty and +;# some items remain unsorted, then there is one or more cycles among them. +;# One way to outline that cycle first extract all those items whose precursor +;# count is minimal then visit their dependency graph to find the cycle, +;# extract only those items belonging to the cycle into the outsiders set and +;# resume the main processing stream. +;# +# +# Topological sort of Makefile dependencies with cycle enhancing. +# + +package tsort; + +# Perform the topological sort of the items and outline cycles. +sub main'tsort { + local(*Succ, *Prec) = @_; # Tables of succesors and predecessors + local(@Out); # The outsider set + local(@keys); # Current active precursors + local($item); # Item to sort + + for (@keys = keys %Prec; @keys || @Out; @keys = keys %Prec) { + &resync; # Resynchronize outsiders + if (@Out == 0) { # Cycle detected + &extract_cycle(*Prec, *Succ); + next; + } + $item = shift(@Out); # Sort current item (don't care which one) + &sort($item); # Update internal structures + } +} + +# Resynchronize the outsiders stack (those items that have no more precursors). +# If the outsiders stack becomes empty, then there is a cycle. +sub resync { + foreach $target (keys %Prec) { + if ($Prec{$target} == 0) { + delete $Prec{$target}; # We're done with this item + push(@Out, $target); # Ready to be sorted + } + } +} + +# Sort item +sub sort { + local($item) = @_; + print "(ok) $item\n" if $main'opt_d && !$Cycle; + print "(fx) $item\n" if $main'opt_d && $Cycle; + foreach $succ (split(' ', $Succ{$item})) { + # The test for definedness is necessary, since when a cycle is found, + # one item is forced out of %Prec. If we had the guarantee of no + # cycle, the the test would not be necessary and no decrementation + # could go past 0. + $Prec{$succ}-- if defined $Prec{$succ}; + } +} + +# Extract cycle... We look through the %Prec array and find all those items +# with the same lowest value. Those are a cycle, so we dump them, and make +# them new outsiders by resetting their count to 0. +sub extract_cycle { + local(*Prec, *Succ) = @_; + local($item) = (&sort_by_value(*Prec))[0]; + local($min) = $Prec{$item}; # Minimum value + local($key, $value); + local(%candidate); # Superset of the cycle we found + warn " Cycle found for:\n"; + $Cycle++; + while (($key, $value) = each %Prec) { + $candidate{$key}++ if $value == $min; + } + local(%state); # State of visited nodes (1 = cycle, -1 = dead) + local($CYCLE) = 1; # Possible member of a cycle + local($DEAD) = -1; # Dead end, no cycling possible + foreach $key (keys %candidate) { + last if $CYCLE == &visit($key, $Succ{$key}); + } + while (($key, $value) = each %candidate) { + next unless $state{$key} == $CYCLE; + $Prec{$key} = 0; # Members of cycle are new outsiders + warn "\t(#$Cycle) $key\n"; + } + local(%involved); # Items involved in the cycle... + while (($key, $value) = each %state) { + $involved{$key}++ if $state{$key} == $CYCLE; + } + &outline_cycle(*Succ, *involved); +} + +sub outline_cycle { + local(*Succ, *member) = @_; + local($key, $value); + local($depends); + local($unit); + warn " Cycle involves:\n"; + while (($key, $value) = each %Succ) { + next unless $member{$key}; + $depends = ''; + foreach $item (split(' ', $value)) { + $depends .= "$item " if $member{$item}; + } + $unit = $main'shmaster{"\$$key"}; + $unit =~ s/\s+$//; + $unit = '?' if $unit eq ''; + warn "\t($unit) $key: $depends\n"; + } +} + +# Visit a tree node, following all its successors, until we find a cycle. +# Return $CYCLE if the exploration of the node leaded to a cycle, $DEAD +# otherwise. +sub visit { + local($node, $children) = @_; # A node and its children + # If we have already visited the node, return the status value attached + # to it. + return $state{$node} if $state{$node}; + $state{$node} = $CYCLE; # Assume member of cycle + local($all_dead) = 1; # Set to 0 if at least one cycle found + foreach $child (split(' ', $children)) { + $all_dead = 0 if $CYCLE == &visit($child, $Succ{$child}); + } + $state{$node} = $DEAD if $all_dead; + $state{$node}; +} + +# Sort associative array by value +sub sort_by_value { + local(*x) = @_; + sub _by_value { $x{$a} <=> $x{$b}; } + sort _by_value keys %x; +} + +package main; + +1; diff --git a/mcon/pl/wanted.pl b/mcon/pl/wanted.pl new file mode 100644 index 0000000..20d218c --- /dev/null +++ b/mcon/pl/wanted.pl @@ -0,0 +1,263 @@ +;# $Id$ +;# +;# Copyright (c) 1991-1997, 2004-2006, Raphael Manfredi +;# +;# You may redistribute only under the terms of the Artistic Licence, +;# as specified in the README file that comes with the distribution. +;# You may reuse parts of this distribution only within the terms of +;# that same Artistic Licence; a copy of which may be found at the root +;# of the source tree for dist 4.0. +;# +;# $Log: wanted.pl,v $ +;# Revision 3.0.1.2 1995/01/11 15:42:37 ram +;# patch45: added % in front of hash table names for perl5's each() (ADO) +;# patch45: tell users about possible extra file-extension lookups +;# +;# Revision 3.0.1.1 1993/10/16 13:56:05 ram +;# patch12: modified to handle ?M: lines +;# patch12: added warning when magic symbols used without proper config +;# +;# Revision 3.0 1993/08/18 12:10:29 ram +;# Baseline for dist 3.0 netwide release. +;# +;# +;# These two arrays record the file names of the files which may (or may not) +;# contain shell or C symbols known by metaconfig. +;# @SHlist records the .SH files +;# @clist records the C-like files (i.e. .[chyl]) +;# +;# These files are scanned in turn to see how many symbols known by metaconfig +;# they have. Those symbols are gathered in a Wanted file. As C symbols are +;# not true targets for the forthcoming Makefile, a ">" sign is prepended. +;# Finally, the obsolete symbols are preceded by a "!". +;# +;# When obsolete symbols are found, they are dumped in file 'Obsolete'. Two +;# files are created anyway in the .MT directory. Obsol_h.U and Obsol_sh.U which +;# respectively list the obsoleted symbols (C and shell ones). +;# Obsol_h.U records obsolete C symbols +;# Obsol_sh.U records obsolete shell symbols +;# +;# The manifake() routine has to be provided externally. +;# +# Build a wanted file from the files held in @SHlist and @clist arrays +sub build_wanted { + # If wanted file is already there, parse it to map obsolete if -o option + # was used. Otherwise, build a new one. + if (-f 'Wanted') { + &map_obsolete if $opt_o; # Build Obsol*.U files + &dump_obsolete; # Dump obsolete symbols if any + return; + } + &parse_files; +} + +sub parse_files { + print "Building a Wanted file...\n" unless $opt_s; + open(WANTED,"| sort | uniq >Wanted") || die "Can't create Wanted.\n"; + unless (-f $NEWMANI) { + &manifake; + die "No $NEWMANI--can't build a Wanted file.\n" unless -f $NEWMANI; + } + + local($search); # Where to-be-evaled script is held + local($_) = ' ' x 50000 if $opt_m; # Pre-extend pattern search space + local(%visited); # Records visited files + local(%lastfound); # Where last occurence of key was + + # Now we are a little clever, and build a loop to eval so that we don't + # have to recompile our patterns on every file. We also use "study" since + # we are searching the same string for many different things. Hauls! + + if (@clist) { + local($others) = $cext ? " $cext" : ''; + print " Scanning .[chyl]$others files for symbols...\n" + unless $opt_s; + $search = ' ' x (40 * (@cmaster + @ocmaster)); # Pre-extend + $search = "while (<>) {study;\n"; # Init loop over ARGV + foreach $key (keys(%cmaster)) { + $search .= "&cmaster('$key') if /\\b$key\\b/;\n"; + } + foreach $key (grep(!/^\$/, keys %Obsolete)) { + $search .= "&ofound('$key') if /\\b$key\\b/;\n"; + } + $search .= "}\n"; # terminate loop + print $search if $opt_d; + @ARGV = @clist; + # Swallow each file as a whole, if memory is available + undef $/ if $opt_m; + eval $search; + eval ''; + $/ = "\n"; + while (($key,$value) = each(%cmaster)) { + print WANTED $cwanted{$key}, "\n", ">$key", "\n" if $value; + } + } + + # If they don't use magic but use magically guarded symbols without + # their corresponding C symbol dependency, warn them, since they might + # not know about that portability issue. + + if (@clist && !$opt_M) { + local($nused); # list of non-used symbols + local($warning) = 0; # true when one warning issued + foreach $cmag (keys %mwanted) { # loop over all used magic symbols + next unless $cmaster{$cmag}; + $nused = ''; + foreach $cdep (split(' ', $mwanted{$cmag})) { + $nused .= " $cdep" unless $cmaster{$cdep}; + } + $nused =~ s/^ //; + $nused = "one of " . $nused if $nused =~ s/ /, /g; + if ($nused ne '') { + print " Warning: $cmag is used without $nused.\n"; + $warning++; + } + } + if ($warning) { + local($those) = $warning == 1 ? 'that' : 'those'; + local($s) = $warning == 1 ? '' : 's'; + print "Note: $those previous warning$s may be suppressed by -M.\n"; + } + } + + # Cannot remove $cmaster as it is used later on when building Configure + undef @clist; + undef %cwanted; + undef %mwanted; + %visited = (); + %lastfound = (); + + if (@SHlist) { + local($others) = $shext ? " $shext" : ''; + print " Scanning .SH$others files for symbols...\n" unless $opt_s; + $search = ' ' x (40 * (@shmaster + @oshmaster)); # Pre-extend + $search = "while (<>) {study;\n"; + # All the keys already have a leading '$' + foreach $key (keys(%shmaster)) { + $search .= "&shmaster('$key') if /\\$key\\b/;\n"; + } + foreach $key (grep (/^\$/, keys %Obsolete)) { + $search .= "&ofound('$key') if /\\$key\\b/;\n"; + } + $search .= "}\n"; + print $search if $opt_d; + @ARGV = @SHlist; + # Swallow each file as a whole, if memory is available + undef $/ if $opt_m; + eval $search; + eval ''; + $/ = "\n"; + while (($key,$value) = each(%shmaster)) { + if ($value) { + $key =~ s/^\$//; + print WANTED $key, "\n"; + } + } + } + + # Obsolete symbols, if any, are written in the Wanted file preceded by a + # '!' character. In case -w is used, we'll thus be able to correctly build + # the Obsol_h.U and Obsol_sh.U files. + + &add_obsolete; # Add obsolete symbols in Wanted file + + close WANTED; + + # If obsolete symbols where found, write an Obsolete file which lists where + # each of them appear and the new symbol to be used. Also write Obsol_h.U + # and Obsol_sh.U in .MT for later perusal. + + &dump_obsolete; # Dump obsolete symbols if any + + die "No desirable symbols found--aborting.\n" unless -s 'Wanted'; + + # Clean-up memory by freeing useless data structures + undef @SHlist; + undef %shmaster; +} + +# This routine records matches of C master keys +sub cmaster { + local($key) = @_; + $cmaster{$key}++; # This symbol is wanted + return unless $opt_t || $opt_M; # Return if neither -t nor -M + if ($opt_t && + $lastfound{$key} ne $ARGV # Never mentionned for this file ? + ) { + $visited{$ARGV}++ || print $ARGV,":\n"; + print "\t$key\n"; + $lastfound{$key} = $ARGV; + } + if ($opt_M && + defined($mwanted{$key}) # Found a ?M: symbol + ) { + foreach $csym (split(' ', $mwanted{$key})) { + $cmaster{$csym}++; # Activate C symbol dependencies + } + } +} + +# This routine records matches of obsolete keys (C or shell) +sub ofound { + local($key) = @_; + local($_) = $Obsolete{$key}; # Value of new symbol + $ofound{"$ARGV $key $_"}++; # Record obsolete match + $cmaster{$_}++ unless /^\$/; # A C hit + $shmaster{$_}++ if /^\$/; # Or a shell one + return unless $opt_t; # Continue if trace option on + if ($lastfound{$key} ne $ARGV) { # Never mentionned for this file ? + $visited{$ARGV}++ || print $ARGV,":\n"; + print "\t$key (obsolete, use $_)\n"; + $lastfound{$key} = $ARGV; + } +} + +# This routine records matches of shell master keys +sub shmaster { + local($key) = @_; + $shmaster{$key}++; # This symbol is wanted + return unless $opt_t; # Continue if trace option on + if ($lastfound{$key} ne $ARGV) { # Never mentionned for this file ? + $visited{$ARGV}++ || print $ARGV,":\n"; + print "\t$key\n"; + $lastfound{$key} = $ARGV; + } +} + +# Write obsolete symbols into the Wanted file for later perusal by -w. +sub add_obsolete { + local($file); # File where obsolete symbol was found + local($old); # Name of this old symbol + local($new); # Value of the new symbol to be used + foreach $key (sort keys %ofound) { + ($file, $old, $new) = ($key =~ /^(\S+)\s+(\S+)\s+(\S+)/); + if ($new =~ s/^\$//) { # We found an obsolete shell symbol + print WANTED "!$old\n"; + } else { # We found an obsolete C symbol + print WANTED "!>$old\n"; + } + } +} + +# Map obsolete symbols from Wanted file into %Obsolete and call dump_obsolete +# to actually build the Obsol_sh.U and Obsol_h.U files. Those will be needed +# during the Configure building phase to actually do the remaping. +# The obsolete symbols found are entered in the %ofound array, tagged as from +# file 'XXX', which is specially recognized by dump_obsolete. +sub map_obsolete { + open(WANTED, 'Wanted') || die "Can't open Wanted file.\n"; + local($new); # New symbol to be used instead of obsolete one + while () { + chop; + next unless s/^!//; # Skip non-obsolete symbols + if (s/^>//) { # C symbol + $new = $Obsolete{$_}; # Fetch new symbol + $ofound{"XXX $_ $new"}++; # Record obsolete match (XXX = no file) + } else { # Shell symbol + $new = $Obsolete{"\$$_"}; # Fetch new symbol + $ofound{"XXX \$$_ $new"}++; # Record obsolete match (XXX = no file) + } + } + close WANTED; +} + diff --git a/mcon/pl/xref.pl b/mcon/pl/xref.pl new file mode 100644 index 0000000..f077139 --- /dev/null +++ b/mcon/pl/xref.pl @@ -0,0 +1,70 @@ +;# $Id$ +;# +;# Copyright (c) 1991-1997, 2004-2006, Raphael Manfredi +;# +;# You may redistribute only under the terms of the Artistic Licence, +;# as specified in the README file that comes with the distribution. +;# You may reuse parts of this distribution only within the terms of +;# that same Artistic Licence; a copy of which may be found at the root +;# of the source tree for dist 4.0. +;# +;# $Log: xref.pl,v $ +;# Revision 3.0.1.2 1995/09/25 09:20:05 ram +;# patch59: added empty p_layout stub for new ?Y: directives +;# +;# Revision 3.0.1.1 1993/10/16 13:56:23 ram +;# patch12: declared p_public for ?P: lines +;# +;# Revision 3.0 1993/08/18 12:10:31 ram +;# Baseline for dist 3.0 netwide release. +;# +;# Metaxref-dependent part of the dependency extranction. +;# +# Process the ?W: lines +sub p_wanted { + # Syntax is ?W:: + local($active) = $_[0] =~ /^([^:]*):/; # Symbols to activate + local($look_symbols) = $_[0] =~ /:(.*)/; # When those are used + local(@syms) = split(/ /, $look_symbols); # Keep original spacing info + $active =~ s/\s+/\n/g; # One symbol per line + + # Concatenate quoted strings, so saying something like 'two words' will + # be introduced as one single symbol "two words". + local(@symbols); # Concatenated symbols to look for + local($concat) = ''; # Concatenation buffer + foreach (@syms) { + if (s/^\'//) { + $concat = $_; + } elsif (s/\'$//) { + push(@symbols, $concat . ' ' . $_); + $concat = ''; + } else { + push(@symbols, $_) unless $concat; + $concat .= ' ' . $_ if $concat; + } + } + + local($fake); # Fake unique shell symbol to reparent C symbol + + # Now record symbols in master and wanted tables + foreach (@symbols) { + $cmaster{$_} = undef; # Asks for look-up in C files + # Make a fake C symbol and associate that with the wanted symbol + # so that later we know were it comes from + $fake = &gensym; + $cwanted{$_} = "$fake"; # Attached to this symbol + push(@Master, "?$unit:$fake=''"); # Fake initialization + } + + delete @cmaster{keys %excluded_symbol}; + delete @cwanted{keys %excluded_symbol}; +} + +# Ingnore the following: +sub p_init {} +sub p_default {} +sub p_library {} +sub p_include {} +sub p_public {} +sub p_layout {} + diff --git a/mcon/pl/xwant.pl b/mcon/pl/xwant.pl new file mode 100644 index 0000000..e1bbf20 --- /dev/null +++ b/mcon/pl/xwant.pl @@ -0,0 +1,149 @@ +;# $Id$ +;# +;# Copyright (c) 1991-1997, 2004-2006, Raphael Manfredi +;# +;# You may redistribute only under the terms of the Artistic Licence, +;# as specified in the README file that comes with the distribution. +;# You may reuse parts of this distribution only within the terms of +;# that same Artistic Licence; a copy of which may be found at the root +;# of the source tree for dist 4.0. +;# +;# $Log: xwant.pl,v $ +;# Revision 3.0 1993/08/18 12:10:32 ram +;# Baseline for dist 3.0 netwide release. +;# +;# +;# These two arrays record the file names of the files which may (or may not) +;# contain shell or C symbols known by metaconfig. +;# @SHlist records the .SH files +;# @clist records the C-like files (i.e. .[chyl]) +;# +# Parse files and build cross references +sub build_xref { + print "Building cross-reference files...\n" unless $opt_s; + unless (-f $NEWMANI) { + &manifake; + die "No $NEWMANI--don't know who to scan.\n" unless -f $NEWMANI; + } + + open(FUI, "|sort | uniq >I.fui") || die "Can't create I.fui.\n"; + open(UIF, "|sort | uniq >I.uif") || die "Can't create I.uif.\n"; + + local($search); # Where to-be-evaled script is held + local($_) = ' ' x 50000 if $opt_m; # Pre-extend pattern search space + local(%visited); # Records visited files + local(%lastfound); # Where last occurence of key was + + # Map shell symbol names to units by reverse engineering the @Master array + # which records all the known shell symbols and the units where they + # are defined. + foreach $init (@Master) { + $init =~ /^\?(.*):(.*)=''/ && ($shwanted{"\$$2"} = $1); + } + + # Now we are a little clever, and build a loop to eval so that we don't + # have to recompile our patterns on every file. We also use "study" since + # we are searching the same string for many different things. Hauls! + + if (@clist) { + print " Scanning .[chyl] files for symbols...\n" unless $opt_s; + $search = ' ' x (40 * (@cmaster + @ocmaster)); # Pre-extend + $search = "while (<>) {study;\n"; # Init loop over ARGV + foreach $key (keys(%cmaster)) { + $search .= "\$cmaster{'$key'} .= \"\$ARGV#\" if /\\b$key\\b/;\n"; + } + foreach $key (grep(!/^\$/, keys %Obsolete)) { + $search .= "&ofound('$key') if /\\b$key\\b/;\n"; + } + $search .= "}\n"; # terminate loop + print $search if $opt_d; + @ARGV = @clist; + # Swallow each file as a whole, if memory is available + undef $/ if $opt_m; + eval $search; + eval ''; + $/ = "\n"; + while (($key,$value) = each(%cmaster)) { + next if $value eq ''; + foreach $file (sort(split(/#/, $value))) { + next if $file eq ''; + # %cwanted may contain value separated by \n -- take last one + @sym = split(/\n/, $cwanted{$key}); + $sym = pop(@sym); + $shell = "\$$sym"; + print FUI + pack("A35", $file), + pack("A20", "$shwanted{$shell}.U"), + $key, "\n"; + print UIF + pack("A20", "$shwanted{$shell}.U"), + pack("A25", $key), + $file, "\n"; + } + } + } + + undef @clist; + undef %cwanted; + undef %cmaster; # We're not building Configure, we may delete this + %visited = (); + %lastfound = (); + + if (@SHlist) { + print " Scanning .SH files for symbols...\n" unless $opt_s; + $search = ' ' x (40 * (@shmaster + @oshmaster)); # Pre-extend + $search = "while (<>) {study;\n"; + # All the keys already have a leading '$' + foreach $key (keys(%shmaster)) { + $search .= "\$shmaster{'$key'} .= \"\$ARGV#\" if /\\$key\\b/;\n"; + } + foreach $key (grep (/^\$/, keys %Obsolete)) { + $search .= "&ofound('$key') if /\\$key\\b/;\n"; + } + $search .= "}\n"; + print $search if $opt_d; + @ARGV = @SHlist; + # Swallow each file as a whole, if memory is available + undef $/ if $opt_m; + eval $search; + eval ''; + $/ = "\n"; + while (($key,$value) = each(%shmaster)) { + next if $value eq ''; + foreach $file (sort(split(/#/, $value))) { + next if $file eq ''; + print FUI + pack("A35", $file), + pack("A20", "$shwanted{$key}.U"), + $key, "\n"; + print UIF + pack("A20", "$shwanted{$key}.U"), + pack("A25", $key), + $file, "\n"; + } + } + } + + close FUI; + close UIF; + + # If obsolete symbols where found, write an Obsolete file which lists where + # each of them appear and the new symbol to be used. Also write Obsol_h.U + # and Obsol_sh.U in .MT for later perusal. + + &dump_obsolete; # Dump obsolete symbols if any + + # Clean-up memory by freeing useless data structures + undef @SHlist; + undef %shmaster; +} + +# This routine records matches of obsolete keys (C or shell) +sub ofound { + local($key) = @_; + local($_) = $Obsolete{$key}; # Value of new symbol + $ofound{"$ARGV $key $_"}++; # Record obsolete match + $cmaster{$_} .= "$ARGV#" unless /^\$/; # A C hit + $shmaster{$_} .= "$ARGV#" if /^\$/; # Or a shell one +} + -- cgit v1.2.3