Prevent errors when run outside metaconfig folder

[metaconfig.git] / bin / mconfig

#!/usr/bin/perl

use sort "stable";
BEGIN { $ENV{LC_ALL} = "C"; }

use FindBin;
use Getopt::Std;

$p5_metaconfig_base = "$FindBin::Bin/../";
chdir "$p5_metaconfig_base/perl" or
    die "perl/ directory missing in $p5_metaconfig_base\n";

-w 'Configure' && -w 'config_h.SH' or
    die "both Configure and config_h.SH must be writable\n";

-l '.package' && -l 'U' or
    die ".package and U should be symlinks as per README\n";

# $Id: mconfig.SH 22 2008-05-28 08:01:59Z rmanfredi $
#
#  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.
#
# Original Author: Larry Wall <lwall@netlabs.com>
# Key Contributor: Harlan Stenn <harlan@mumps.pfcs.com>
#
# $Log: mconfig.SH,v $
# Revision 3.0.1.5  1995/07/25  14:19:05  ram
# patch56: new -G option
#
# Revision 3.0.1.4  1994/06/20  07:11:04  ram
# patch30: new -L option to override public library path for testing
#
# Revision 3.0.1.3  1994/01/24  14:20:53  ram
# patch16: added ~/.dist_profile awareness
#
# Revision 3.0.1.2  1993/10/16  13:53:10  ram
# patch12: new -M option for magic symbols and confmagic.h production
#
# Revision 3.0.1.1  1993/08/19  06:42:26  ram
# patch1: leading config.sh searching was not aborting properly
#
# Revision 3.0  1993/08/18  12:10:17  ram
# Baseline for dist 3.0 netwide release.
#

# Perload ON

$MC = "$p5_metaconfig_base/dist";
$version = '3.5';
$patchlevel = '0';
$grep = '/usr/bin/grep';
chop($date = `date`);
&profile;						# Read ~/.dist_profile
&usage unless getopts("dhkmoOstvwGMVL:X:");

$MC = $opt_L if $opt_L;			# May override public library path
$MC = &tilda_expand($MC);		# ~name expansion
chop($WD = `pwd`);				# Working directory
chdir $MC || die "Can't chdir to $MC: $!\n";
chop($MC = `pwd`);				# Real metaconfig lib path (no symbolic links)
chdir $WD || die "Can't chdir back to $WD: $!\n";

++$opt_k if $opt_d;
++$opt_M if -f 'confmagic.h';	# Force -M if confmagic.h already there

if ($opt_V) {
	print STDERR "metaconfig $version PL$patchlevel\n";
	exit 0;
} elsif ($opt_h) {
	&usage;
}

unlink 'Wanted' unless $opt_w;			# Wanted rebuilt if no -w
unlink 'Obsolete' unless $opt_w;		# Obsolete file rebuilt if no -w
&readpackage;							# Merely get the package's name
&init;									# Various initializations
my %excluded_symbol;
read_exclusions($opt_X);				# Load -X or .package equivalent
`mkdir .MT 2>&1` unless -d '.MT';		# For private temporary files

&locate_units;				# Fill in @ARGV with a unit list
&extract_dependencies;		# Extract dependencies from units
&extract_filenames;			# Extract files to be scanned for
&build_wanted;				# Build a list of wanted symbols in file Wanted
&build_makefile;			# To do the transitive closure of dependencies
&solve_dependencies;		# Now run the makefile to close dependency graph
&create_configure;			# Create the Configure script and related files
&cosmetic_update;			# Update the manifests

if ($opt_k) {
	print "Leaving subdirectory .MT unremoved so you can peruse it.\n"
		unless $opt_s;
} else {
	`rm -rf .MT 2>&1`;
}
system $^X, "Porting/config_h.pl";
print "Done.\n" unless $opt_s;

# General initializations
sub init {
	&init_except;			# Token which have upper-cased letters
	&init_keep;				# The keep status for built-in interpreter
	&init_priority;			# Priorities for diadic operators
	&init_constants;		# Define global constants
	&init_depend;			# The %Depend array records control line handling
}

sub init_constants {
	$NEWMANI = 'MANIFEST.new';		# List of files to be scanned
	$MANI = 'MANIFEST';				# For manifake

	# The distinction between MANIFEST.new and MANIFEST can make sense
	# when the "pat" tools are used, but if only metaconfig is used, then
	# we can very well leave without a MANIFEST.new.  --RAM, 2006-08-25
	$NEWMANI = $MANI if -f $MANI && ! -f $NEWMANI;
}

# Record the exceptions -- almost all symbols but these are lower case
# We also use three symbols from Unix.U for default file suffixes.
sub init_except {
	$Except{'Author'}++;
	$Except{'Date'}++;
	$Except{'Header'}++;
	$Except{'Id'}++;
	$Except{'Locker'}++;
	$Except{'Log'}++;
	$Except{'RCSfile'}++;
	$Except{'Revision'}++;
	$Except{'Source'}++;
	$Except{'State'}++;
	$Except{'_a'}++;
	$Except{'_o'}++;
	$Except{'_exe'}++;
}

# Print out metaconfig's usage and exits
sub usage {
	print STDERR <<'EOH';
Usage: metaconfig [-dhkmostvwGMV] [-L dir] [-X file]
  -d : debug mode.
  -h : print this help message and exits.
  -k : keep temporary directory.
  -m : assume lots of memory and swap space.
  -o : maps obsolete symbols on new ones.
  -s : silent mode.
  -t : trace symbols as they are found.
  -v : verbose mode.
  -w : trust Wanted file as being up-to-date.
  -G : also provide a GNU configure-like front end.
  -L : specify main units repository.
  -M : activate production of confmagic.h.
  -V : print version number and exits.
  -X : read symbol exclusions from file (overriding .package)
EOH
	exit 1;
}

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
			$::opt_O and next;
			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;

# 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)

# Process the ?W: lines
sub p_wanted {
	# Syntax is ?W:<shell symbols>:<C symbols>
	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 <sym> <file> <notdef symbols list>
		# 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
	}
}

# 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,
	);
}

# 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 (<FILE>) {
			$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/%</$unit/g;			# %< expands into the unit's name
				if (s/%\*/$unit/) {
					# %* expanded into the entire set of defined symbols
					# in the old version. Now it is only the unit's name.
					++$old_version;
				}
				eval { &$proc($_) };		# Process the line
			} else {
				next file unless $body;		# No procedure to handle body
				do {
					$line = $_;				# Save last processed unit line
					eval { &$body($_) } ;	# From now on, it's the unit body
				} while (defined ($_ = <FILE>));
				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 . $_;
		}
	}
}

# 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 (<NEWMANI>) {
		($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(<<EOF);		# Function being built
:sub $name {
:	local(\$_) = \@_;
EOF
	local($single);		# Single regexp: .c .h grouped into .[ch]
	$single = '\.[' . join('', @single) . ']' if @single;
	$fn .= &q(<<EOL) if @single;
:	return 1 if /$single\$/;
EOL
	foreach $ext (@others) {
		$fn .= &q(<<EOL);
:	return 1 if /$ext\$/;
EOL
	}
	$fn .= &q(<<EOF);
:	0;	# None of the extensions may be applied to file name
:}
EOF
	print $fn if $opt_d;
	eval $fn;
	chop($@) && die "Can't compile '$name':\n$fn\n$@.\n";
}

# Remove ':' quotations in front of the lines
sub q {
	local($_) = @_;
	s/^://gm;
	$_;
}

sub read_exclusions {
	my ($filename) = @_;
	if (!defined $filename) {
		$filename = $exclusions_file; # default to name from .package
		return if !defined $filename || $filename eq '';
	}
	print "Reading exclusions from $filename...\n" unless $opt_s;
	open(EXCLUSIONS, "< $filename\0") || die "Can't read $filename: $!\n";
	local $_;
	while (<EXCLUSIONS>) {
		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";
}

# 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 (<WANTED>) {
		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;
}

# 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
}

# 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 (<WANTED>) {
		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 (<MAKE>) {
		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;
}

# 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 (<MAKE>) {
		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;
}

# 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 UNIT (name: $name, target: $target) $file.\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 (<UNIT>) {
			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 (<UNIT>) {
			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 (<UNIT>) {
			s/<PACKAGENAME>/$package/g;
			s/<MAINTLOC>/$maintloc/g;
			s/<VERSION>/$version/g;			# This is metaconfig's version
			s/<PATCHLEVEL>/$patchlevel/g;	# And patchlevel information
			s/<DATE>/$date/g;
			s/<BASEREV>/$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 (<UNIT>) {
			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 (<UNIT>) {
			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 (<UNIT>) {
			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 (<UNIT>) {
				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 (<TARGET>) {
				print PREPEND unless &skipped;
			}
			print PREPEND <UNIT>;	# 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;
}

# 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(<CONF_H>) {
		++$blank_lines if /^$/;
	}
	unlink 'config_h.SH' unless $blank_lines > 3;

	open(NEWMANI,$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
	$_ = <NEWMANI>;
	$/ = "\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 (<OLDMANI>) {
		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";
	}
}

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 .= $_;
		$_ = <UNIT>;		# 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;

sub readpackage {
	if (! -f '.package') {
		if (
			-f '../.package' ||
			-f '../../.package' ||
			-f '../../../.package' ||
			-f '../../../../.package'
		) {
			die "Run in top level directory only.\n";
		} else {
			die "No .package file!  Run packinit.\n";
		}
	}
	open(PACKAGE,'.package');
	while (<PACKAGE>) {
		next if /^:/;
		next if /^#/;
		if (($var,$val) = /^\s*(\w+)=(.*)/) {
			$val = "\"$val\"" unless $val =~ /^['"]/;
			eval "\$$var = $val;";
		}
	}
	close PACKAGE;
}

sub manifake {
    # make MANIFEST and MANIFEST.new say the same thing
    if (! -f $NEWMANI) {
        if (-f $MANI) {
            open(IN,$MANI) || die "Can't open $MANI";
            open(OUT,">$NEWMANI") || die "Can't create $NEWMANI";
            while (<IN>) {
                if (/---/) {
					# Everything until now was a header...
					close OUT;
					open(OUT,">$NEWMANI") ||
						die "Can't recreate $NEWMANI";
					next;
				}
                s/^\s*(\S+\s+)[0-9]*\s*(.*)/$1$2/;
				print OUT;
				print OUT "\n" unless /\n$/;	# If no description
            }
            close IN;
			close OUT;
        }
        else {
die "You need to make a $NEWMANI file, with names and descriptions.\n";
        }
    }
}

# Perform ~name expansion ala ksh...
# (banish csh from your vocabulary ;-)
sub tilda_expand {
	local($path) = @_;
	return $path unless $path =~ /^~/;
	$path =~ s:^~([^/]+):(getpwnam($1))[$[+7]:e;			# ~name
	$path =~ s:^~:$ENV{'HOME'} || (getpwuid($<))[$[+7]:e;	# ~
	$path;
}

# Set up profile components into %Profile, add any profile-supplied options
# into @ARGV and return the command invocation name.
sub profile {
	local($profile) = &tilda_expand($ENV{'DIST'} || '~/.dist_profile');
	local($me) = $0;		# Command name
	$me =~ s|.*/(.*)|$1|;	# Keep only base name
	return $me unless -s $profile;
	local(*PROFILE);		# Local file descriptor
	local($options) = '';	# Options we get back from profile
	unless (open(PROFILE, $profile)) {
		warn "$me: cannot open $profile: $!\n";
		return;
	}
	local($_);
	local($component);
	while (<PROFILE>) {
		next if /^\s*#/;	# Skip comments
		next unless /^$me/o;
		if (s/^$me://o) {	# progname: options
			chop;
			$options .= $_;	# Merge options if more than one line
		}
		elsif (s/^$me-([^:]+)://o) {	# progname-component: value
			$component = $1;
			chop;
			s/^\s+//;		# Trim leading and trailing spaces
			s/\s+$//;
			$Profile{$component} = $_;
		}
	}
	close PROFILE;
	return unless $options;
	require 'shellwords.pl';
	local(@opts);
	eval '@opts = &shellwords($options)';	# Protect against mismatched quotes
	unshift(@ARGV, @opts);
	return $me;				# Return our invocation name
}