4 BEGIN { $ENV{LC_ALL} = "C"; }
5 chdir "/pro/3gl/CPAN/perl";
6 { my @Cc = qw( Configure config_h.SH );
7 system "chown merijn @Cc";
9 #-d "merijn" or mkdir "merijn";
10 #system "cp -f Configure config_h.SH Porting/Glossary Porting/config.sh merijn/";
11 system "ls", "-l", @Cc;
14 # $Id: mconfig.SH 22 2008-05-28 08:01:59Z rmanfredi $
16 # Copyright (c) 1991-1997, 2004-2006, Raphael Manfredi
18 # You may redistribute only under the terms of the Artistic Licence,
19 # as specified in the README file that comes with the distribution.
20 # You may reuse parts of this distribution only within the terms of
21 # that same Artistic Licence; a copy of which may be found at the root
22 # of the source tree for dist 4.0.
24 # Original Author: Larry Wall <lwall@netlabs.com>
25 # Key Contributor: Harlan Stenn <harlan@mumps.pfcs.com>
27 # $Log: mconfig.SH,v $
28 # Revision 3.0.1.5 1995/07/25 14:19:05 ram
29 # patch56: new -G option
31 # Revision 3.0.1.4 1994/06/20 07:11:04 ram
32 # patch30: new -L option to override public library path for testing
34 # Revision 3.0.1.3 1994/01/24 14:20:53 ram
35 # patch16: added ~/.dist_profile awareness
37 # Revision 3.0.1.2 1993/10/16 13:53:10 ram
38 # patch12: new -M option for magic symbols and confmagic.h production
40 # Revision 3.0.1.1 1993/08/19 06:42:26 ram
41 # patch1: leading config.sh searching was not aborting properly
43 # Revision 3.0 1993/08/18 12:10:17 ram
44 # Baseline for dist 3.0 netwide release.
49 $MC = '/pro/3gl/CPAN/lib/dist';
52 $grep = '/usr/bin/grep';
54 &profile; # Read ~/.dist_profile
56 &usage unless &Getopts("dhkmoOstvwGMVL:");
58 $MC = $opt_L if $opt_L; # May override public library path
59 $MC = &tilda_expand($MC); # ~name expansion
60 chop($WD = `pwd`); # Working directory
61 chdir $MC || die "Can't chdir to $MC: $!\n";
62 chop($MC = `pwd`); # Real metaconfig lib path (no symbolic links)
63 chdir $WD || die "Can't chdir back to $WD: $!\n";
66 ++$opt_M if -f 'confmagic.h'; # Force -M if confmagic.h already there
69 print STDERR "metaconfig $version PL$patchlevel\n";
75 unlink 'Wanted' unless $opt_w; # Wanted rebuilt if no -w
76 unlink 'Obsolete' unless $opt_w; # Obsolete file rebuilt if no -w
77 &readpackage; # Merely get the package's name
78 &init; # Various initializations
79 `mkdir .MT 2>&1` unless -d '.MT'; # For private temporary files
81 &locate_units; # Fill in @ARGV with a unit list
82 &extract_dependencies; # Extract dependencies from units
83 &extract_filenames; # Extract files to be scanned for
84 &build_wanted; # Build a list of wanted symbols in file Wanted
85 &build_makefile; # To do the transitive closure of dependencies
86 &solve_dependencies; # Now run the makefile to close dependency graph
87 &create_configure; # Create the Configure script and related files
88 &cosmetic_update; # Update the manifests
91 print "Leaving subdirectory .MT unremoved so you can peruse it.\n"
96 system "/pro/bin/perl", "Porting/config_h.pl";
97 print "Done.\n" unless $opt_s;
99 # General initializations
101 &init_except; # Token which have upper-cased letters
102 &init_keep; # The keep status for built-in interpreter
103 &init_priority; # Priorities for diadic operators
104 &init_constants; # Define global constants
105 &init_depend; # The %Depend array records control line handling
109 $NEWMANI = 'MANIFEST.new'; # List of files to be scanned
110 $MANI = 'MANIFEST'; # For manifake
112 # The distinction between MANIFEST.new and MANIFEST can make sense
113 # when the "pat" tools are used, but if only metaconfig is used, then
114 # we can very well leave without a MANIFEST.new. --RAM, 2006-08-25
115 $NEWMANI = $MANI if -f $MANI && ! -f $NEWMANI;
118 # Record the exceptions -- almost all symbols but these are lower case
119 # We also use three symbols from Unix.U for default file suffixes.
127 $Except{'RCSfile'}++;
128 $Except{'Revision'}++;
136 # Print out metaconfig's usage and exits
138 print STDERR <<'EOH';
139 Usage: metaconfig [-dhkmostvwGMV] [-L dir]
141 -h : print this help message and exits.
142 -k : keep temporary directory.
143 -m : assume lots of memory and swap space.
144 -o : maps obsolete symbols on new ones.
146 -t : trace symbols as they are found.
148 -w : trust Wanted file as being up-to-date.
149 -G : also provide a GNU configure-like front end.
150 -L : specify main units repository.
151 -M : activate production of confmagic.h.
152 -V : print version number and exits.
159 # Locate the units and push their path in @ARGV (sorted alphabetically)
160 sub main'locate_units {
161 print "Locating units...\n" unless $main'opt_s;
162 local(*WD) = *main'WD; # Current working directory
163 local(*MC) = *main'MC; # Public metaconfig library
164 undef %myUlist; # Records private units paths
165 undef %myUseen; # Records private/public conflicts
166 &private_units; # Locate private units in @myUlist
167 &public_units; # Locate public units in @ARGV
168 @ARGV = sort @ARGV; # Sort it alphabetically
169 push(@ARGV, sort @myUlist); # Append user's units sorted
170 &dump_list if $main'opt_v; # Dump the list of units
173 # Dump the list of units on stdout
184 return unless -d 'U'; # Nothing to be done if no 'U' entry
185 local(*ARGV) = *myUlist; # Really fill in @myUlist
186 local($MC) = $WD; # We are really in the working directory
187 &units_path("U"); # Locate units in the U directory
188 local($unit_name); # Unit's name (without .U)
189 local(@kept); # Array of kept units
190 # Loop over the units and remove duplicates (the first one seen is the one
191 # we keep). Also set the %myUseen H table to record private units seen.
193 ($unit_name) = m|^.*/(.*)\.U$|; # Get unit's name from path
194 next if $myUseen{$unit_name}; # Already recorded
195 $myUseen{$unit_name} = 1; # Record pirvate unit
196 push(@kept, $_); # Keep this unit
203 chdir($MC) || die "Can't find directory $MC.\n";
204 &units_path("U"); # Locate units in public U directory
205 chdir($WD) || die "Can't go back to directory $WD.\n";
206 local($path); # Relative path from $WD
207 local($unit_name); # Unit's name (without .U)
208 local(*Unit) = *main'Unit; # Unit is a global from main package
209 local(@kept); # Units kept
210 local(%warned); # Units which have already issued a message
211 # Loop over all the units and keep only the ones that were not found in
212 # the user's U directory. As it is possible two or more units with the same
215 ($unit_name) = m|^.*/(.*)\.U$|; # Get unit's name from path
216 next if $warned{$unit_name}; # We have already seen this unit
217 $warned{$unit_name} = 1; # Remember we have warned the user
218 if ($myUseen{$unit_name}) { # User already has a private unit
219 $path = $Unit{$unit_name}; # Extract user's unit path
220 next if $path eq $_; # Same path, we must be in mcon/
221 $path =~ s|^$WD/||o; # Weed out leading working dir path
223 print " Your private $path overrides the public one.\n"
226 push(@kept, $_); # We may keep this one
232 # Recursively locate units in the directory. Each file ending with .U has to be
233 # a unit. Others are stat()'ed, and if they are a directory, they are also
234 # scanned through. The $MC and @ARGV variable are dynamically set by the caller.
236 local($dir) = @_; # Directory where units are to be found
237 local(@contents); # Contents of the directory
238 local($unit_name); # Unit's name, without final .U
239 local($path); # Full path of a unit
240 local(*Unit) = *main'Unit; # Unit is a global from main package
241 unless (opendir(DIR, $dir)) {
242 warn("Cannot open directory $dir.\n");
245 print "Locating in $MC/$dir...\n" if $main'opt_v;
246 @contents = readdir DIR; # Slurp the whole thing
247 closedir DIR; # And close dir, ready for recursion
248 foreach (@contents) {
249 next if $_ eq '.' || $_ eq '..';
250 if (/\.U$/) { # A unit, definitely
251 ($unit_name) = /^(.*)\.U$/;
252 $path = "$MC/$dir/$_"; # Full path of unit
253 push(@ARGV, $path); # Record its path
254 if (defined $Unit{$unit_name}) { # Already seen this unit
256 ($path) = $Unit{$unit_name} =~ m|^(.*)/.*|;
257 print " We've already seen $unit_name.U in $path.\n";
260 $Unit{$unit_name} = $path; # Map name to path
264 # We have found a file which does not look like a unit. If it is a
265 # directory, then scan it. Otherwise skip the file.
266 unless (-d "$dir/$_") {
267 print " Skipping file $_ in $dir.\n" if $main'opt_v;
270 &units_path("$dir/$_");
271 print "Back to $MC/$dir...\n" if $main'opt_v;
277 # Initialize the extraction process by setting some variables.
278 # We return a string to be eval to do more customized initializations.
279 sub init_extraction {
280 open(INIT, ">$WD/.MT/Init.U") ||
281 die "Can't create .MT/Init.U\n";
282 open(CONF_H, ">$WD/.MT/Config_h.U") ||
283 die "Can't create .MT/Config_h.U\n";
284 open(EXTERN, ">$WD/.MT/Extern.U") ||
285 die "Can't create .MT/Extern.U\n";
286 open(MAGIC_H, ">$WD/.MT/Magic_h.U") ||
287 die "Can't create .MT/Magic_h.U\n";
289 $c_symbol = ''; # Current symbol seen in ?C: lines
290 $s_symbol = ''; # Current symbol seen in ?S: lines
291 $m_symbol = ''; # Current symbol seen in ?M: lines
292 $heredoc = ''; # Last "here" document symbol seen
293 $heredoc_nosubst = 0; # True for <<'EOM' here docs
294 $condlist = ''; # List of conditional symbols
295 $defined = ''; # List of defined symbols in the unit
296 $body = ''; # No procedure to handle body
297 $ending = ''; # No procedure to clean-up
300 # End the extraction process
302 close EXTERN; # External dependencies (libraries, includes...)
303 close CONF_H; # C symbol definition template
304 close INIT; # Required initializations
305 close MAGIC; # Magic C symbol redefinition templates
307 print $dependencies if $opt_v; # Print extracted dependencies
310 # Process the ?MAKE: line
313 local(@ary); # Locally defined symbols
314 local(@dep); # Dependencies
315 if (/^[\w+ ]*:/) { # Main dependency rule
316 s|^\s*||; # Remove leading spaces
319 @dep = split(' ', $1); # Dependencies
320 @ary = split(' '); # Locally defined symbols
321 foreach $sym (@ary) {
322 # Symbols starting with a '+' are meant for internal use only.
323 next if $sym =~ s/^\+//;
324 # Only sumbols starting with a lowercase letter are to
325 # appear in config.sh, excepted the ones listed in Except.
326 if ($sym =~ /^[_a-z]/ || $Except{$sym}) {
327 $shmaster{"\$$sym"} = undef;
328 push(@Master,"?$unit:$sym=''\n"); # Initializations
331 $condlist = ''; # List of conditional symbols
332 local($sym); # Symbol copy, avoid @dep alteration
333 foreach $dep (@dep) {
334 if ($dep =~ /^\+[A-Za-z]/) {
335 ($sym = $dep) =~ s|^\+||;
336 $condlist .= "$sym ";
337 push(@Cond, $sym) unless $condseen{$sym};
338 $condseen{$sym}++; # Conditionally wanted
341 # Append to already existing dependencies. The 'defined' variable
342 # is set for &write_out, used to implement ?L: and ?I: canvas. It is
343 # reset each time a new unit is parsed.
344 # NB: leading '+' for defined symbols (internal use only) have been
345 # removed at this point, but conditional dependencies still bear it.
346 $defined = join(' ', @ary); # Symbols defined by this unit
347 $dependencies .= $defined . ':' . join(' ', @dep) . "\n";
348 $dependencies .= " -cond $condlist\n" if $condlist;
350 $dependencies .= $_; # Building rules
354 # Process the ?O: line
357 $Obsolete{"$unit.U"} .= $_; # Message(s) to print if unit is used
360 # Process the ?S: lines
366 print " ?S: $s_symbol\n" if $opt_d;
368 warn "\"$file\", line $.: syntax error in ?S: construct.\n";
372 # Deal with obsolete symbol list (enclosed between parenthesis)
373 &record_obsolete("\$$_") if /\(/;
375 m|^\.\s*$| && ($s_symbol = ''); # End of comment
378 # Process the ?C: lines
382 if (s/^(\w+)\s*~\s*(\S+)\s*(.*):/$1 $3:/) {
383 # The ~ operator aliases the main C symbol to another symbol which
384 # is to be used instead for definition in config.h. That is to say,
385 # the line '?C:SYM ~ other:' would look for symbol 'other' instead,
386 # and the documentation for symbol SYM would only be included in
387 # config.h if 'other' were actually wanted.
388 $c_symbol = $2; # Alias for definition in config.h
389 print " ?C: $1 ~ $c_symbol\n" if $opt_d;
390 } elsif (/^(\w+).*:/) {
391 # Default behaviour. Include in config.h if symbol is needed.
393 print " ?C: $c_symbol\n" if $opt_d;
395 warn "\"$file\", line $.: syntax error in ?C: construct.\n";
399 # Deal with obsolete symbol list (enclosed between parenthesis) and
400 # make sure that list do not appear in config.h.SH by removing it.
401 &record_obsolete("$_") if /\(/;
402 s/\s*\(.*\)//; # Get rid of obsolete symbol list
404 s|^(\w+)\s*|?$c_symbol:/* $1| || # Start of comment
405 (s|^\.\s*$|?$c_symbol: */\n| && ($c_symbol = '', 1)) || # End of comment
406 s|^(.*)|?$c_symbol: *$1|; # Middle of comment
407 &p_config("$_"); # Add comments to config.h.SH
410 # Process the ?H: lines
413 local($constraint); # Constraint to be used for inclusion
414 ++$old_version if s/^\?%1://; # Old version
415 if (s/^\?(\w+)://) { # Remove leading '?var:'
416 $constraint = $1; # Constraint is leading '?var'
418 $constraint = ''; # No constraint
420 if (/^#.*\$/) { # Look only for cpp lines
421 if (m|^#\$(\w+)\s+(\w+).*\$(\w+)|) {
422 # Case: #$d_var VAR "$var"
423 $constraint = $2 unless $constraint;
424 print " ?H: ($constraint) #\$$1 $2 \"\$$3\"\n" if $opt_d;
425 $cmaster{$2} = undef;
426 $cwanted{$2} = "$1\n$3";
427 } elsif (m|^#define\s+(\w+)\((.*)\)\s+\$(\w+)|) {
428 # Case: #define VAR(x) $var
429 $constraint = $1 unless $constraint;
430 print " ?H: ($constraint) #define $1($2) \$$3\n" if $opt_d;
431 $cmaster{$1} = undef;
433 } elsif (m|^#\$define\s+(\w+)|) {
435 $constraint = $1 unless $constraint;
436 print " ?H: ($constraint) #define $1\n" if $opt_d;
437 $cmaster{$1} = undef;
438 $cwanted{$1} = "define\n$unit";
439 } elsif (m|^#\$(\w+)\s+(\w+)|) {
441 $constraint = $2 unless $constraint;
442 print " ?H: ($constraint) #\$$1 $2\n" if $opt_d;
443 $cmaster{$2} = undef;
445 } elsif (m|^#define\s+(\w+).*\$(\w+)|) {
446 # Case: #define VAR "$var"
447 $constraint = $1 unless $constraint;
448 print " ?H: ($constraint) #define $1 \"\$$2\"\n" if $opt_d;
449 $cmaster{$1} = undef;
452 $constraint = $unit unless $constraint;
453 print " ?H: ($constraint) $_" if $opt_d;
456 print " ?H: ($constraint) $_" if $opt_d;
458 # If not a single ?H:. line, add the leading constraint
459 s/^\.// || s/^/?$constraint:/;
463 # Process the ?M: lines
467 if (/^(\w+):\s*([\w\s]*)\n$/) {
468 # A '?M:sym:' line implies a '?W:%<:sym' since we'll need to know
469 # about the wantedness of sym later on when building confmagic.h.
470 # Buf is sym is wanted, then the C symbol dependencies have to
471 # be triggered. That is done by introducing sym in the mwanted
472 # array, known by the Wanted file construction process...
474 print " ?M: $m_symbol\n" if $opt_d;
475 $mwanted{$m_symbol} = $2; # Record C dependencies
476 &p_wanted("$unit:$m_symbol"); # Build fake ?W: line
478 warn "\"$file\", line $.: syntax error in ?M: construct.\n";
482 (s/^\.\s*$/?$m_symbol:\n/ && ($m_symbol = '', 1)) || # End of block
484 print MAGIC_H; # Definition goes to confmagic.h
485 print " ?M: $_" if $opt_d;
488 sub p_ignore {} # Ignore comment line
489 sub p_lint {} # Ignore lint directives
490 sub p_visible {} # No visible checking in metaconfig
491 sub p_temp {} # No temporary variable control
492 sub p_file {} # Ignore produced file directives (for now)
494 # Process the ?W: lines
496 # Syntax is ?W:<shell symbols>:<C symbols>
497 local($active) = $_[0] =~ /^([^:]*):/; # Symbols to activate
498 local($look_symbols) = $_[0] =~ /:(.*)/; # When those are used
499 local(@syms) = split(/ /, $look_symbols); # Keep original spacing info
500 $active =~ s/\s+/\n/g; # One symbol per line
502 # Concatenate quoted strings, so saying something like 'two words' will
503 # be introduced as one single symbol "two words".
504 local(@symbols); # Concatenated symbols to look for
505 local($concat) = ''; # Concatenation buffer
510 push(@symbols, $concat . ' ' . $_);
513 push(@symbols, $_) unless $concat;
514 $concat .= ' ' . $_ if $concat;
518 # Now record symbols in master and wanted tables
520 $cmaster{$_} = undef; # Asks for look-up in C files
521 $cwanted{$_} = "$active" if $active; # Shell symbols to activate
525 # Process the ?INIT: lines
528 print INIT "?$unit:", $_; # Wanted only if unit is loaded
531 # Process the ?D: lines
534 s/^([A-Za-z_]+)=(.*)/\@if !$1\n%$1:$1=$2\n\@define $1\n\@end/
535 && ($hasdefault{$1}++, print INIT $_);
538 # Process the ?P: lines
541 local($csym); # C symbol(s) we're trying to look at
542 local($nosym); # List of symbol(s) which mustn't be wanted
543 local($cfile); # Name of file implementing csym (no .ext)
544 ($csym, $nosym, $cfile) = /([^()]+)\s*(\(.*\))\s*:\s*(\S+)/;
545 unless ($csym eq '' || $cfile eq '') {
546 # Add dependencies for each C symbol, of the form:
547 # -pick public <sym> <file> <notdef symbols list>
548 # and the file will be added to config.c whenever sym is wanted and
549 # none of the notdef symbols is wanted.
550 foreach $sym (split(' ', $csym)) {
551 $dependencies .= "\t-pick public $sym $cfile $nosym\n";
556 # Process the ?Y: lines
557 # Valid layouts are for now are: top, bottom, default.
560 # This routine relies on the $defined variable, a global variable set
561 # during the ?MAKE: processing, which lists all the defined symbols in
562 # the unit (the optional leading '+' for internal symbols has been removed
565 # The routine fills up a %Layout table, indexed by symbol, yielding the
566 # layout imposed to this unit. That table will then be used later on when
567 # we sort wanted symbols for the Makefile.
570 local($layout) = /^\s*(\w+)/;
571 $layout =~ tr/A-Z/a-z/; # Case is not significant for layouts
572 unless (defined $Lcmp{$layout}) {
573 warn "\"$file\", line $.: unknown layout directive '$layout'.\n";
576 foreach $sym (split(' ', $defined)) {
577 $Layout{$sym} = $Lcmp{$layout};
581 # Process the ?L: lines
582 # There should not be any '-l' in front of the library name
587 # Process the ?I: lines
592 # Write out line in file Extern.U. The information recorded there has the
593 # following prototypical format:
595 # If 'symbol' is wanted, then 'inet bsd' will be added to $libswanted.
598 local($target) = $defined; # By default, applies to defined symbols
599 $target = $1 if s/^(.*)://; # List is qualified "?L:target:symbols"
600 local(@target) = split(' ', $target);
602 foreach $key (@target) {
603 print EXTERN "?$key:$_\n"; # EXTERN file defined in xref.pl
607 # The %Depend array records the functions we use to process the configuration
608 # lines in the unit, with a special meaning. It is important that all the
609 # known control symbols be listed below, so that metalint does not complain.
610 # The %Lcmp array contains valid layouts and their comparaison value.
613 'MAKE', 'p_make', # The ?MAKE: line records dependencies
614 'INIT', 'p_init', # Initializations printed verbatim
615 'LINT', 'p_lint', # Hints for metalint
616 'RCS', 'p_ignore', # RCS comments are ignored
617 'C', 'p_c', # C symbols
618 'D', 'p_default', # Default value for conditional symbols
619 'E', 'p_example', # Example of usage
620 'F', 'p_file', # Produced files
621 'H', 'p_config', # Process the config.h lines
622 'I', 'p_include', # Added includes
623 'L', 'p_library', # Added libraries
624 'M', 'p_magic', # Process the confmagic.h lines
625 'O', 'p_obsolete', # Unit obsolescence
626 'P', 'p_public', # Location of PD implementation file
627 'S', 'p_shell', # Shell variables
628 'T', 'p_temp', # Shell temporaries used
629 'V', 'p_visible', # Visible symbols like 'rp', 'dflt'
630 'W', 'p_wanted', # Wanted value for interpreter
631 'X', 'p_ignore', # User comment is ignored
632 'Y', 'p_layout', # User-defined layout preference
641 # Extract dependencies from units held in @ARGV
642 sub extract_dependencies {
643 local($proc); # Procedure used to handle a ctrl line
644 local($file); # Current file scanned
645 local($dir, $unit); # Directory and unit's name
646 local($old_version) = 0; # True when old-version unit detected
647 local($mc) = "$MC/U"; # Public metaconfig directory
648 local($line); # Last processed line for metalint
650 printf "Extracting dependency lists from %d units...\n", $#ARGV+1
653 chdir $WD; # Back to working directory
654 &init_extraction; # Initialize extraction files
655 $dependencies = ' ' x (50 * @ARGV); # Pre-extend
658 # We do not want to use the <> construct here, because we need the
659 # name of the opened files (to get the unit's name) and we want to
660 # reset the line number for each files, and do some pre-processing.
662 file: while ($file = shift(@ARGV)) {
663 close FILE; # Reset line number
664 $old_version = 0; # True if unit is an old version
665 if (open(FILE, $file)) {
666 ($dir, $unit) = ('', $file)
667 unless ($dir, $unit) = ($file =~ m|(.*)/(.*)|);
668 $unit =~ s|\.U$||; # Remove extension
670 warn("Can't open $file.\n");
672 # If unit is in the standard public directory, keep only the unit name
673 $file = "$unit.U" if $dir eq $mc;
674 print "$dir/$unit.U:\n" if $opt_d;
675 line: while (<FILE>) {
676 $line = $_; # Save last processed unit line
677 if (s/^\?([\w\-]+)://) { # We may have found a control line
678 $proc = $Depend{$1}; # Look for a procedure to handle it
679 unless ($proc) { # Unknown control line
680 $proc = $1; # p_unknown expects symbol in '$proc'
681 eval '&p_unknown'; # Signal error (metalint only)
682 next line; # And go on next line
684 # Long lines may be escaped with a final backslash
685 $_ .= &complete_line(FILE) if s/\\\s*$//;
686 # Run macros substitutions
687 s/%</$unit/g; # %< expands into the unit's name
689 # %* expanded into the entire set of defined symbols
690 # in the old version. Now it is only the unit's name.
693 eval { &$proc($_) }; # Process the line
695 next file unless $body; # No procedure to handle body
697 $line = $_; # Save last processed unit line
698 eval { &$body($_) } ; # From now on, it's the unit body
699 } while (defined ($_ = <FILE>));
704 warn(" Warning: $file is a pre-3.0 version.\n") if $old_version;
705 &$ending($line) if $ending; # Post-processing for metalint
708 &end_extraction; # End the extraction process
711 # The first line was escaped with a final \ character. Every following line
712 # is to be appended to it (until we found a real \n not escaped). Note that
713 # the leading spaces of the continuation line are removed, so any space should
714 # be added before the former \ if needed.
716 local($file) = @_; # File where lines come from
718 local($read) = ''; # Concatenation of all the continuation lines found
720 s/^\s+//; # Remove leading spaces
721 if (s/\\\s*$//) { # Still followed by a continuation line
723 } else { # We've reached the end of the continuation
729 # Extract filenames from manifest
730 sub extract_filenames {
731 &build_filext; # Construct &is_cfile and &is_shfile
732 print "Extracting filenames (C and SH files) from $NEWMANI...\n"
734 open(NEWMANI,$NEWMANI) || die "Can't open $NEWMANI.\n";
737 ($file) = split(' ');
738 next if $file eq 'config_h.SH'; # skip config_h.SH
739 next if $file eq 'Configure'; # also skip Configure
740 next if $file eq 'confmagic.h' && $opt_M;
741 push(@SHlist, $file) if &is_shfile($file);
742 push(@clist, $file) if &is_cfile($file);
746 # Construct two file identifiers based on the file suffix: one for C files,
747 # and one for SH files (using the $cext and $shext variables) defined in
749 # The &is_cfile and &is_shfile routine may then be called to known whether
750 # a given file is a candidate for holding C or SH symbols.
752 &build_extfun('is_cfile', $cext, '.c .h .y .l');
753 &build_extfun('is_shfile', $shext, '.SH');
756 # Build routine $name to identify extensions listed in $exts, ensuring
757 # that $minimum is at least matched (both to be backward compatible with
758 # older .package and because it is really the minimum requirred).
760 local($name, $exts, $minimum) = @_;
761 local(@single); # Single letter dot extensions (may be grouped)
762 local(@others); # Other extensions
763 local(%seen); # Avoid duplicate extensions
764 foreach $ext (split(' ', "$exts $minimum")) {
765 next if $seen{$ext}++;
766 if ($ext =~ s/^\.(\w)$/$1/) {
769 # Convert into perl's regexp
770 $ext =~ s/\./\\./g; # Escape .
771 $ext =~ s/\?/./g; # ? turns into .
772 $ext =~ s/\*/.*/g; # * turns into .*
776 local($fn) = &q(<<EOF); # Function being built
780 local($single); # Single regexp: .c .h grouped into .[ch]
781 $single = '\.[' . join('', @single) . ']' if @single;
782 $fn .= &q(<<EOL) if @single;
783 : return 1 if /$single\$/;
785 foreach $ext (@others) {
787 : return 1 if /$ext\$/;
791 : 0; # None of the extensions may be applied to file name
796 chop($@) && die "Can't compile '$name':\n$fn\n$@.\n";
799 # Remove ':' quotations in front of the lines
806 # Build a wanted file from the files held in @SHlist and @clist arrays
808 # If wanted file is already there, parse it to map obsolete if -o option
809 # was used. Otherwise, build a new one.
811 &map_obsolete if $opt_o; # Build Obsol*.U files
812 &dump_obsolete; # Dump obsolete symbols if any
819 print "Building a Wanted file...\n" unless $opt_s;
820 open(WANTED,"| sort | uniq >Wanted") || die "Can't create Wanted.\n";
821 unless (-f $NEWMANI) {
823 die "No $NEWMANI--can't build a Wanted file.\n" unless -f $NEWMANI;
826 local($search); # Where to-be-evaled script is held
827 local($_) = ' ' x 50000 if $opt_m; # Pre-extend pattern search space
828 local(%visited); # Records visited files
829 local(%lastfound); # Where last occurence of key was
831 # Now we are a little clever, and build a loop to eval so that we don't
832 # have to recompile our patterns on every file. We also use "study" since
833 # we are searching the same string for many different things. Hauls!
836 local($others) = $cext ? " $cext" : '';
837 print " Scanning .[chyl]$others files for symbols...\n"
839 $search = ' ' x (40 * (@cmaster + @ocmaster)); # Pre-extend
840 $search = "while (<>) {study;\n"; # Init loop over ARGV
841 foreach $key (keys(%cmaster)) {
842 $search .= "&cmaster('$key') if /\\b$key\\b/;\n";
844 foreach $key (grep(!/^\$/, keys %Obsolete)) {
845 $search .= "&ofound('$key') if /\\b$key\\b/;\n";
847 $search .= "}\n"; # terminate loop
848 print $search if $opt_d;
850 # Swallow each file as a whole, if memory is available
855 while (($key,$value) = each(%cmaster)) {
856 print WANTED $cwanted{$key}, "\n", ">$key", "\n" if $value;
860 # If they don't use magic but use magically guarded symbols without
861 # their corresponding C symbol dependency, warn them, since they might
862 # not know about that portability issue.
864 if (@clist && !$opt_M) {
865 local($nused); # list of non-used symbols
866 local($warning) = 0; # true when one warning issued
867 foreach $cmag (keys %mwanted) { # loop over all used magic symbols
868 next unless $cmaster{$cmag};
870 foreach $cdep (split(' ', $mwanted{$cmag})) {
871 $nused .= " $cdep" unless $cmaster{$cdep};
874 $nused = "one of " . $nused if $nused =~ s/ /, /g;
876 print " Warning: $cmag is used without $nused.\n";
881 local($those) = $warning == 1 ? 'that' : 'those';
882 local($s) = $warning == 1 ? '' : 's';
883 print "Note: $those previous warning$s may be suppressed by -M.\n";
887 # Cannot remove $cmaster as it is used later on when building Configure
895 local($others) = $shext ? " $shext" : '';
896 print " Scanning .SH$others files for symbols...\n" unless $opt_s;
897 $search = ' ' x (40 * (@shmaster + @oshmaster)); # Pre-extend
898 $search = "while (<>) {study;\n";
899 # All the keys already have a leading '$'
900 foreach $key (keys(%shmaster)) {
901 $search .= "&shmaster('$key') if /\\$key\\b/;\n";
903 foreach $key (grep (/^\$/, keys %Obsolete)) {
904 $search .= "&ofound('$key') if /\\$key\\b/;\n";
907 print $search if $opt_d;
909 # Swallow each file as a whole, if memory is available
914 while (($key,$value) = each(%shmaster)) {
917 print WANTED $key, "\n";
922 # Obsolete symbols, if any, are written in the Wanted file preceded by a
923 # '!' character. In case -w is used, we'll thus be able to correctly build
924 # the Obsol_h.U and Obsol_sh.U files.
926 &add_obsolete; # Add obsolete symbols in Wanted file
930 # If obsolete symbols where found, write an Obsolete file which lists where
931 # each of them appear and the new symbol to be used. Also write Obsol_h.U
932 # and Obsol_sh.U in .MT for later perusal.
934 &dump_obsolete; # Dump obsolete symbols if any
936 die "No desirable symbols found--aborting.\n" unless -s 'Wanted';
938 # Clean-up memory by freeing useless data structures
943 # This routine records matches of C master keys
946 $cmaster{$key}++; # This symbol is wanted
947 return unless $opt_t || $opt_M; # Return if neither -t nor -M
949 $lastfound{$key} ne $ARGV # Never mentionned for this file ?
951 $visited{$ARGV}++ || print $ARGV,":\n";
953 $lastfound{$key} = $ARGV;
956 defined($mwanted{$key}) # Found a ?M: symbol
958 foreach $csym (split(' ', $mwanted{$key})) {
959 $cmaster{$csym}++; # Activate C symbol dependencies
964 # This routine records matches of obsolete keys (C or shell)
967 local($_) = $Obsolete{$key}; # Value of new symbol
968 $ofound{"$ARGV $key $_"}++; # Record obsolete match
969 $cmaster{$_}++ unless /^\$/; # A C hit
970 $shmaster{$_}++ if /^\$/; # Or a shell one
971 return unless $opt_t; # Continue if trace option on
972 if ($lastfound{$key} ne $ARGV) { # Never mentionned for this file ?
973 $visited{$ARGV}++ || print $ARGV,":\n";
974 print "\t$key (obsolete, use $_)\n";
975 $lastfound{$key} = $ARGV;
979 # This routine records matches of shell master keys
982 $shmaster{$key}++; # This symbol is wanted
983 return unless $opt_t; # Continue if trace option on
984 if ($lastfound{$key} ne $ARGV) { # Never mentionned for this file ?
985 $visited{$ARGV}++ || print $ARGV,":\n";
987 $lastfound{$key} = $ARGV;
991 # Write obsolete symbols into the Wanted file for later perusal by -w.
993 local($file); # File where obsolete symbol was found
994 local($old); # Name of this old symbol
995 local($new); # Value of the new symbol to be used
996 foreach $key (sort keys %ofound) {
997 ($file, $old, $new) = ($key =~ /^(\S+)\s+(\S+)\s+(\S+)/);
998 if ($new =~ s/^\$//) { # We found an obsolete shell symbol
999 print WANTED "!$old\n";
1000 } else { # We found an obsolete C symbol
1001 print WANTED "!>$old\n";
1006 # Map obsolete symbols from Wanted file into %Obsolete and call dump_obsolete
1007 # to actually build the Obsol_sh.U and Obsol_h.U files. Those will be needed
1008 # during the Configure building phase to actually do the remaping.
1009 # The obsolete symbols found are entered in the %ofound array, tagged as from
1010 # file 'XXX', which is specially recognized by dump_obsolete.
1012 open(WANTED, 'Wanted') || die "Can't open Wanted file.\n";
1013 local($new); # New symbol to be used instead of obsolete one
1016 next unless s/^!//; # Skip non-obsolete symbols
1017 if (s/^>//) { # C symbol
1018 $new = $Obsolete{$_}; # Fetch new symbol
1019 $ofound{"XXX $_ $new"}++; # Record obsolete match (XXX = no file)
1020 } else { # Shell symbol
1021 $new = $Obsolete{"\$$_"}; # Fetch new symbol
1022 $ofound{"XXX \$$_ $new"}++; # Record obsolete match (XXX = no file)
1028 # Record obsolete symbols association (new versus old), that is to say for a
1029 # given old symbol, $Obsolete{'old'} = new symbol to be used. A '$' is prepended
1030 # for all shell variables
1031 sub record_obsolete {
1033 local(@obsoleted); # List of obsolete symbols
1034 local($symbol); # New symbol which must be used
1035 local($dollar) = s/^\$// ? '$':''; # The '$' or a null string
1036 # Syntax for obsolete symbols specification is
1037 # list of symbols (obsolete ones):
1038 if (/^(\w+)\s*\((.*)\)\s*:$/) {
1039 $symbol = "$dollar$1";
1040 @obsoleted = split(' ', $2); # List of obsolete symbols
1042 if (/^(\w+)\s*\((.*):$/) {
1043 warn "\"$file\", line $.: final ')' before ':' missing.\n";
1044 $symbol = "$dollar$1";
1045 @obsoleted = split(' ', $2);
1047 warn "\"$file\", line $.: syntax error.\n";
1051 foreach $val (@obsoleted) {
1052 $_ = $dollar . $val;
1053 if (defined $Obsolete{$_}) {
1054 warn "\"$file\", line $.: '$_' already obsoleted by '$Obsolete{$_}'.\n";
1056 $Obsolete{$_} = $symbol; # Record (old, new) tuple
1061 # Dump obsolete symbols used in file 'Obsolete'. Also write Obsol_h.U and
1062 # Obsol_sh.U to record old versus new mappings if the -o option was used.
1064 unless (-f 'Obsolete') {
1065 open(OBSOLETE, ">Obsolete") || die "Can't create Obsolete.\n";
1067 open(OBSOL_H, ">.MT/Obsol_h.U") || die "Can't create .MT/Obsol_h.U.\n";
1068 open(OBSOL_SH, ">.MT/Obsol_sh.U") || die "Can't create .MT/Obsol_sh.U.\n";
1069 local($file); # File where obsolete symbol was found
1070 local($old); # Name of this old symbol
1071 local($new); # Value of the new symbol to be used
1072 # Leave a blank line at the top so that anny added ^L will stand on a line
1073 # by itself (the formatting process adds a ^L when a new page is needed).
1074 format OBSOLETE_TOP =
1076 File | Old symbol | New symbol
1077 -----------------------------------+----------------------+---------------------
1080 @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< | @<<<<<<<<<<<<<<<<<<< | @<<<<<<<<<<<<<<<<<<<
1084 foreach $key (sort keys %ofound) {
1085 ($file, $old, $new) = ($key =~ /^(\S+)\s+(\S+)\s+(\S+)/);
1086 write(OBSOLETE) unless $file eq 'XXX';
1087 next unless $opt_o; # Obsolete mapping done only with -o
1088 next if $seen{$old}++; # Already remapped, thank you
1089 if ($new =~ s/^\$//) { # We found an obsolete shell symbol
1091 print OBSOL_SH "$old=\"\$$new\"\n";
1092 } else { # We found an obsolete C symbol
1093 print OBSOL_H "#ifdef $new\n";
1094 print OBSOL_H "#define $old $new\n";
1095 print OBSOL_H "#endif\n\n";
1101 if (-s 'Obsolete') {
1102 print "*** Obsolete symbols found -- see file 'Obsolete' for a list.\n";
1106 undef %ofound; # Not needed any more
1109 # Build the private makefile we use to compute the transitive closure of the
1110 # previously determined dependencies.
1111 sub build_makefile {
1112 print "Computing optimal dependency graph...\n" unless $opt_s;
1113 chdir('.MT') || die "Can't chdir to .MT\n";
1114 local($wanted); # Wanted shell symbols
1115 &build_private; # Build a first makefile from dependencies
1116 &compute_loadable; # Compute loadable units
1117 &update_makefile; # Update makefile using feedback from first pass
1118 chdir($WD) || die "Can't chdir back to $WD\n";
1119 # Free memory by removing useless data structures
1120 undef $dependencies;
1121 undef $saved_dependencies;
1124 # First pass: build a private makefile from the extracted dependency, changing
1125 # conditional units to truly wanted ones if the symbol is used, removing the
1126 # dependency otherwise. The original dependencies are saved.
1128 print " Building private make file...\n" unless $opt_s;
1129 open(WANTED,"../Wanted") || die "Can't reopen Wanted.\n";
1130 $wanted = ' ' x 2000; # Pre-extend string
1134 next if /^!/; # Skip obsolete symbols
1143 # The wanted symbols are sorted so that d_* (checking for C library symbol)
1144 # come first and i_* (checking for includes) comes at the end. Grouping the
1145 # d_* symbols together has good chances of improving the locality of the
1146 # other questions and i_* symbols must come last since some depend on h_*
1147 # values which prevent incompatible headers inclusions.
1148 $wanted = join(' ', sort symbols split(' ', $wanted));
1150 # Now generate the first makefile, which will be used to determine which
1151 # symbols we really need, so that conditional dependencies may be solved.
1152 open(MAKEFILE,">Makefile") || die "Can't create .MT/Makefile.\n";
1153 print MAKEFILE "SHELL = /bin/sh\n";
1154 print MAKEFILE "W = $wanted\n";
1155 $saved_dependencies = $dependencies;
1156 foreach $sym (@Cond) {
1157 if ($symwanted{$sym}) {
1158 $dependencies =~ s/\+($sym\s)/$1/gm;
1160 $dependencies =~ s/\+$sym(\s)/$1/gm;
1163 print MAKEFILE $dependencies;
1167 # Ordering for symbols. Give higher priority to d_* ones and lower to i_* ones.
1168 # If any layout priority is defined in %Layout, it is used to order the
1171 local($r) = $Layout{$a} <=> $Layout{$b};
1173 # If we come here, both symbols have the same layout priority.
1175 return -1 unless $b =~ /^d_/;
1176 } elsif ($b =~ /^d_/) {
1178 } elsif ($a =~ /^i_/) {
1179 return 1 unless $b =~ /^i_/;
1180 } elsif ($b =~ /^i_/) {
1186 # Run the makefile produced in the first pass to find the whole set of units we
1187 # have to load, filling in the %symwanted and %condwanted structures.
1188 sub compute_loadable {
1189 print " Determining loadable units...\n" unless $opt_s;
1190 open(MAKE, "make -n |") || die "Can't run make";
1192 s|^\s+||; # Some make print tabs before command
1194 print "\t$_" if $opt_v;
1195 ($pick,$cmd,$symbol,$unit) = split(' ');
1196 $symwanted{$symbol}++;
1197 $symwanted{$unit}++;
1199 print "\t$_" if $opt_v;
1200 ($pick,@symbol) = split(' ');
1202 $condwanted{$_}++; # Default value is requested
1209 # Now that we know all the desirable symbols, we have to rebuild
1210 # another makefile, in order to have the units in a more optimal
1212 # Actually, if we have both ?MAKE:a:+b and ?MAKE:d:b and 'd' is
1213 # wanted; then 'b' will be loaded. However, 'b' is a conditional
1214 # dependency for 'a', and it would be better if 'b' were loaded
1215 # before 'a' is, though this is not necessary.
1216 # It is hard to know that 'b' will be loaded *before* the first make.
1218 # Back to the original dependencies, make loadable units truly wanted ones and
1219 # remove optional ones.
1220 sub update_makefile {
1221 print " Updating make file...\n" unless $opt_s;
1222 open(MAKEFILE,">Makefile") || die "Can't create .MT/Makefile.\n";
1223 print MAKEFILE "SHELL = /bin/sh\n";
1224 print MAKEFILE "W = $wanted\n";
1225 foreach $sym (@Cond) {
1226 if ($symwanted{$sym}) {
1227 $saved_dependencies =~ s/\+($sym\s)/$1/gm;
1229 $saved_dependencies =~ s/\+$sym(\s)/$1/gm;
1232 print MAKEFILE $saved_dependencies;
1236 # Solve dependencies by saving the 'pick' command in @cmdwanted
1237 sub solve_dependencies {
1238 local(%unitseen); # Record already picked units (avoid duplicates)
1239 print "Determining the correct order for the units...\n" unless $opt_s;
1240 chdir('.MT') || die "Can't chdir to .MT: $!.\n";
1241 open(MAKE, "make -n |") || die "Can't run make";
1243 s|^\s+||; # Some make print tabs before command
1244 print "\t$_" if $opt_v;
1246 ($pick,$cmd,$symbol,$unit) = split(' ');
1247 push(@cmdwanted,"$cmd $symbol $unit")
1248 unless $unitseen{"$cmd:$unit"}++;
1250 # Ignore conditional symbol request
1256 chdir($WD) || die "Can't chdir to $WD: $!.\n";
1260 # Create the Configure script
1261 sub create_configure {
1262 print "Creating Configure...\n" unless $opt_s;
1263 open(CONFIGURE,">Configure") || die "Can't create Configure: $!\n";
1264 open(CONF_H,">config_h.SH") || die "Can't create config_h.SH: $!\n";
1266 open(MAGIC_H,">confmagic.h") || die "Can't create confmagic.h: $!\n";
1269 chdir('.MT') || die "Can't cd to .MT: $!\n";
1271 &process_command($_); # Run the makefile command
1273 chdir($WD) || die "Can't cd back to $WD\n";
1275 print CONF_H "#endif\n"; # Close the opened #ifdef (see Config_h.U)
1276 print CONF_H "!GROK!THIS!\n";
1279 print MAGIC_H "#endif\n"; # Close the opened #ifdef (see Magic_h.U)
1282 `chmod +x Configure`;
1285 # Process a Makefile 'pick' command
1286 sub process_command {
1287 local($cmd, $target, $unit_name) = split(' ', $_[0]);
1288 local($name) = $unit_name . '.U'; # Restore missing .U
1289 local($file) = $name; # Where unit is located
1290 unless ($file =~ m|^\./|) { # Unit produced earlier by metaconfig
1291 $file = $Unit{$unit_name}; # Fetch unit from U directory
1293 if (defined $Obsolete{$name}) { # Signal use of an obsolete unit
1294 warn "\tObsolete unit $name is used:\n";
1295 local(@msg) = split(/\n/, $Obsolete{$name});
1296 foreach $msg (@msg) {
1300 die "Can't open $file.\n" unless open(UNIT, $file);
1301 print "\t$cmd $file\n" if $opt_v;
1302 &init_interp; # Initializes the interpreter
1304 # The 'add' command adds the unit to Configure.
1305 if ($cmd eq 'add') {
1307 print CONFIGURE unless &skipped || !&interpret($_);
1311 # The 'weed' command adds the unit to Configure, but
1312 # makes some tests for the lines starting with '?' or '%'.
1313 # These lines are kept only if the symbol is wanted.
1314 elsif ($cmd eq 'weed') {
1317 s/^\?\w+:// if $symwanted{$1};
1320 s/^%\w+:// if $condwanted{$1};
1322 print CONFIGURE unless &skipped || !&interpret($_);
1326 # The 'wipe' command adds the unit to Configure, but
1327 # also substitues some hardwired macros.
1328 elsif ($cmd eq 'wipe') {
1330 s/<PACKAGENAME>/$package/g;
1331 s/<MAINTLOC>/$maintloc/g;
1332 s/<VERSION>/$version/g; # This is metaconfig's version
1333 s/<PATCHLEVEL>/$patchlevel/g; # And patchlevel information
1335 s/<BASEREV>/$baserev/g;
1336 s/<\$(\w+)>/eval("\$$1")/ge; # <$var> -> $var substitution
1337 print CONFIGURE unless &skipped || !&interpret($_);
1341 # The 'add.Null' command adds empty initializations
1342 # to Configure for all the shell variable used.
1343 elsif ($cmd eq 'add.Null') {
1344 for (sort @Master) {
1346 s/^\?\w+:// if $symwanted{$1};
1348 print CONFIGURE unless &skipped;
1351 print CONFIGURE "$_=''\n"
1352 unless $symwanted{$_} || $hasdefault{$_};
1355 print CONFIGURE unless &skipped || !&interpret($_);
1357 print CONFIGURE "CONFIG=''\n\n";
1360 # The 'add.Config_sh' command fills in the production of
1361 # the config.sh script within Configure. Only the used
1362 # variable are added, the conditional ones are skipped.
1363 elsif ($cmd eq 'add.Config_sh') {
1365 print CONFIGURE unless &skipped || !&interpret($_);
1367 for (sort @Master) {
1369 # Can't use $shmaster, because config.sh must
1370 # also contain some internal defaults used by
1371 # Configure (e.g. nm_opt, libc, etc...).
1372 s/^\?\w+:// if $symwanted{$1};
1374 s/^(\w+)=''/$1='\$$1'/;
1375 print CONFIGURE unless &skipped;
1379 # The 'close.Config_sh' command adds the final EOT line at
1380 # the end of the here-document construct which produces the
1381 # config.sh file within Configure.
1382 elsif ($cmd eq 'close.Config_sh') {
1383 print CONFIGURE "EOT\n\n"; # Ends up file
1386 # The 'c_h_weed' command produces the config_h.SH file.
1387 # Only the necessary lines are kept. If no conditional line is
1388 # ever printed, then the file is useless and will be removed.
1389 elsif ($cmd eq 'c_h_weed') {
1393 s/^\?\w+:// if $cmaster{$1} || $symwanted{$1};
1395 unless (&skipped || !&interpret($_)) {
1397 print CONF_H "\n" if $printed;
1407 # The 'cm_h_weed' command produces the confmagic.h file.
1408 # Only the necessary lines are kept. If no conditional line is
1409 # ever printed, then the file is useless and will be removed.
1410 elsif ($cmd eq 'cm_h_weed') {
1415 s/^\?\w+:// if $cmaster{$1} || $symwanted{$1};
1417 unless (&skipped || !&interpret($_)) {
1419 print MAGIC_H "\n" if $printed;
1430 # The 'prepend' command will add the content of the target to
1431 # the current file (held in $file, the one which UNIT refers to),
1432 # if the file is not empty.
1433 elsif ($cmd eq 'prepend') {
1435 open(PREPEND, ">.prepend") ||
1436 die "Can't create .MT/.prepend.\n";
1437 open(TARGET, $Unit{$target}) ||
1438 die "Can't open $Unit{$target}.\n";
1440 print PREPEND unless &skipped;
1442 print PREPEND <UNIT>; # Now add original file contents
1445 rename('.prepend', $file) ||
1446 die "Can't rename .prepend into $file.\n";
1452 die "Unrecognized command from Makefile: $cmd\n";
1454 &check_state; # Make sure there are no pending statements
1458 # Skip lines starting with ? or %, including all the following continuation
1459 # lines, if any. Return 0 if the line was not to be skipped, 1 otherwise.
1461 return 0 unless /^\?|^%/;
1462 &complete_line(UNIT) if /\\\s*$/; # Swallow continuation lines
1466 # Update the MANIFEST.new file if necessary
1467 sub cosmetic_update {
1468 # Check for an "empty" config_h.SH (2 blank lines only). This test relies
1469 # on the actual text held in Config_h.U. If the unit is modified, then the
1470 # following might need adjustments.
1471 local($blank_lines) = 0;
1473 open(CONF_H, 'config_h.SH') || die "Can't open config_h.SH\n";
1475 ++$blank_lines if /^$/;
1477 unlink 'config_h.SH' unless $blank_lines > 3;
1479 open(NEWMANI,$NEWMANI);
1481 /(\S+\s+)\S+/ && ($spaces = length($1)); # Spaces wanted
1483 $spaces = 29 if ($spaces < 12); # Default value
1484 open(NEWMANI,$NEWMANI);
1485 $/ = "\001"; # Swallow the whole file
1490 &mani_add('Configure', 'Portability tool', $spaces) unless /^Configure\b/m;
1491 &mani_add('config_h.SH', 'Produces config.h', $spaces)
1492 unless /^config_h\.SH\b/m || !-f 'config_h.SH';
1493 &mani_add('confmagic.h', 'Magic symbol remapping', $spaces)
1494 if $opt_M && !/^confmagic\.h\b/m;
1496 &mani_remove('config_h.SH') if /^config_h\.SH\b/m && !-f 'config_h.SH';
1497 &mani_remove('confmagic.h') if /^confmagic.h\b/m && !$opt_M;
1499 if ($opt_G) { # Want a GNU-like configure wrapper
1501 &mani_add('configure', 'GNU configure-like wrapper', $spaces)
1502 if !/^configure\s/m && -f 'configure';
1504 &mani_remove('configure') if /^configure\s/m && !-f 'configure';
1508 # Add file to MANIFEST.new, with properly indented comment
1510 local($file, $comment, $spaces) = @_;
1511 print "Adding $file to your $NEWMANI file...\n" unless $opt_s;
1512 open(NEWMANI, ">>$NEWMANI") || warn "Can't add $file to $NEWMANI: $!\n";
1513 local($blank) = ' ' x ($spaces - length($file));
1514 print NEWMANI "${file}${blank}${comment}\n";
1518 # Remove file from MANIFEST.new
1521 print "Removing $file from $NEWMANI...\n" unless $opt_s;
1522 unless (open(NEWMANI, ">$NEWMANI.x")) {
1523 warn "Can't create backup $NEWMANI copy: $!\n";
1526 unless (open(OLDMANI, $NEWMANI)) {
1527 warn "Can't open $NEWMANI: $!\n";
1532 print NEWMANI unless /^$file\b/
1536 rename("$NEWMANI.x", $NEWMANI) ||
1537 warn "Couldn't restore $NEWMANI from $NEWMANI.x\n";
1540 # Copy GNU-like configure wrapper to the package root directory
1542 if (-f "$MC/configure") {
1543 print "Copying GNU configure-like front end...\n" unless $opt_s;
1544 system "cp $MC/configure ./configure";
1545 `chmod +x configure`;
1547 warn "Can't locate $MC/configure: $!\n";
1551 package interpreter;
1553 # States used by our interpeter -- in sync with @Keep
1554 sub main'init_keep {
1555 # Status in which we keep lines -- $Keep[$status]
1556 @Keep = (0, 1, 1, 0, 1);
1558 # Available status ($status)
1566 # Priorities for operators -- magic numbers :-)
1567 sub main'init_priority {
1568 $Priority{'&&'} = 4;
1569 $Priority{'||'} = 3;
1572 # Initializes the state stack of the interpreter
1573 sub main'init_interp {
1578 # Print error messages -- asssumes $unit and $. correctly set.
1580 warn "\"$main'file\", line $.: @_.\n";
1583 # If some states are still in the stack, warn the user
1584 sub main'check_state {
1585 &error("one statement pending") if $#state == 1;
1586 &error("$#state statements pending") if $#state > 1;
1589 # Add a value on the stack, modified by all the monadic operators.
1590 # We use the locals @val and @mono from eval_expr.
1592 local($val) = shift(@_);
1593 while ($#mono >= 0) {
1594 # Cheat... the only monadic operator is '!'.
1601 # Execute a stacked operation, leave result in stack.
1602 # We use the locals @val and @op from eval_expr.
1603 # If the value stack holds only one operand, do nothing.
1605 return unless $#val > 0;
1606 local($op) = pop(@op);
1607 local($val1) = pop(@val);
1608 local($val2) = pop(@val);
1609 push(@val, eval("$val1 $op $val2") ? 1: 0);
1612 # Given an operator, either we add it in the stack @op, because its
1613 # priority is lower than the one on top of the stack, or we first execute
1614 # the stacked operations until we reach the end of stack or an operand
1615 # whose priority is lower than ours.
1616 # We use the locals @val and @op from eval_expr.
1618 local($op) = shift(@_); # Operator
1619 if (!$Priority{$op}) {
1620 &error("illegal operator $op");
1624 &error("missing first operand for '$op' (diadic operator)");
1627 # Because of the special behaviour of do-SUBR with the while modifier,
1628 # I'm using a while-BLOCK construct. I consider this to be a bug of perl
1629 # 4.0 PL19, although it is clearly documented in the man page.
1631 $Priority{$op[$#op]} > $Priority{$op} # Higher priority op
1632 && $#val > 0 # At least 2 values
1634 &execute; # Execute an higher priority stacked operation
1636 push(@op, $op); # Everything at higher priority has been executed
1640 # This is the heart of our little interpreter. Here, we evaluate
1641 # a logical expression and return its value.
1643 local(*expr) = shift(@_); # Expression to parse
1644 local(@val) = (); # Stack of values
1645 local(@op) = (); # Stack of diadic operators
1646 local(@mono) =(); # Stack of monadic operators
1650 s/^\s+//; # Remove spaces between words
1653 &push_val(&eval_expr(*_));
1654 # A final '\' indicates an end of line
1655 &error("missing final parenthesis") if !s/^\\//;
1657 # Found a ')' or end of line
1658 elsif (/^\)/ || /^$/) {
1659 s/^\)/\\/; # Signals: left parenthesis found
1660 $expr = $_; # Remove interpreted stuff
1661 &execute() while $#val > 0; # Executed stacked operations
1664 &error("missing second operand for '$_' (diadic operator)");
1668 # A perl statement '{{'
1670 if (s/^(.*)\}\}//) {
1672 ('perl','-e', "if ($1) {exit 0;} else {exit 1;}"
1675 &error("incomplete perl statement");
1678 # A shell statement '{'
1682 ("if $1 >/dev/null 2>&1; then exit 0; else exit 1; fi"
1685 &error("incomplete shell statement");
1688 # Operator '||' and '&&'
1689 elsif (s/^(\|\||&&)//) {
1690 $tmp = $1; # Save for perl5 (Dataloaded update_stack)
1691 &update_stack($tmp);
1693 # Unary operator '!'
1697 # Everything else is a test for a defined value
1698 elsif (s/^([\?%]?\w+)//) {
1701 if ($tmp =~ s/^\?//) {
1702 &push_val(($main'symwanted{$tmp})? 1 : 0);
1704 # Test for conditionally wanted
1705 elsif ($tmp =~ s/^%//) {
1706 &push_val(($main'condwanted{$tmp})? 1 : 0);
1708 # Default: test for definition (see op @define)
1711 $main'symwanted{$tmp} ||
1712 $main'cmaster{$tmp} ||
1713 $main'userdef{$tmp}) ? 1 : 0);
1716 # An error occured -- we did not recognize the expression
1718 s/^([^\s\(\)\{\|&!]+)//; # Skip until next meaningful char
1723 # Given an expression in a '@' command, returns a boolean which is
1724 # the result of the evaluation. Evaluate is collecting all the lines
1725 # in the expression into a single string, and then calls eval_expr to
1726 # really evaluate it.
1728 local($val); # Value returned
1729 local($expr) = ""; # Expression to be parsed
1731 while (s/\\$//) { # While end of line escaped
1733 $_ = <UNIT>; # Fetch next line
1735 &error("EOF in expression");
1741 while ($expr ne '') {
1742 $val = &eval_expr(*expr); # Expression will be modified
1743 # We return from eval_expr either when a closing parenthisis
1744 # is found, or when the expression has been fully analysed.
1745 &error("extra closing parenthesis ignored") if $expr ne '';
1750 # Given a line, we search for commands (lines starting with '@').
1751 # If there is no command in the line, then we return the boolean state.
1752 # Otherwise, the command is analysed and a new state is computed.
1753 # The returned value of interpret is 1 if the line is to be printed.
1754 sub main'interpret {
1756 local($status) = $state[$#state]; # Current status
1757 if (s|^\s*@\s*(\w+)\s*(.*)|$2|) {
1759 $cmd =~ y/A-Z/a-z/; # Canonicalize to lower case
1760 # The 'define' command
1761 if ($cmd eq 'define') {
1763 $userdef{$_}++ if $Keep[$status];
1767 elsif ($cmd eq 'if') {
1768 # We always evaluate, in order to find possible errors
1769 $value = &evaluate($_);
1770 if (!$Keep[$status]) {
1771 # We have to skip until next 'end'
1772 push(@state, $SKIP); # Record structure
1775 if ($value) { # True
1783 # The 'else' command
1784 elsif ($cmd eq 'else') {
1785 &error("expression after 'else' ignored") if /\S/;
1786 $state[$#state] = $SKIP if $state[$#state] == $IF;
1787 return 0 if $state[$#state] == $SKIP;
1788 if ($state[$#state] == $OUT) {
1789 &error("unexpected 'else'");
1792 $state[$#state] = $ELSE;
1795 # The 'elsif' command
1796 elsif ($cmd eq 'elsif') {
1797 # We always evaluate, in order to find possible errors
1798 $value = &evaluate($_);
1799 $state[$#state] = $SKIP if $state[$#state] == $IF;
1800 return 0 if $state[$#state] == $SKIP;
1801 if ($state[$#state] == $OUT) {
1802 &error("unexpected 'elsif'");
1805 if ($value) { # True
1806 $state[$#state] = $IF;
1809 $state[$#state] = $NOT;
1814 elsif ($cmd eq 'end') {
1815 &error("expression after 'end' ignored") if /\S/;
1817 &error("unexpected 'end'") if $#state < 0;
1822 &error("unknown command '$cmd'");
1832 if (! -f '.package') {
1835 -f '../../.package' ||
1836 -f '../../../.package' ||
1837 -f '../../../../.package'
1839 die "Run in top level directory only.\n";
1841 die "No .package file! Run packinit.\n";
1844 open(PACKAGE,'.package');
1848 if (($var,$val) = /^\s*(\w+)=(.*)/) {
1849 $val = "\"$val\"" unless $val =~ /^['"]/;
1850 eval "\$$var = $val;";
1857 # make MANIFEST and MANIFEST.new say the same thing
1858 if (! -f $NEWMANI) {
1860 open(IN,$MANI) || die "Can't open $MANI";
1861 open(OUT,">$NEWMANI") || die "Can't create $NEWMANI";
1864 # Everything until now was a header...
1866 open(OUT,">$NEWMANI") ||
1867 die "Can't recreate $NEWMANI";
1870 s/^\s*(\S+\s+)[0-9]*\s*(.*)/$1$2/;
1872 print OUT "\n" unless /\n$/; # If no description
1878 die "You need to make a $NEWMANI file, with names and descriptions.\n";
1883 # Perform ~name expansion ala ksh...
1884 # (banish csh from your vocabulary ;-)
1887 return $path unless $path =~ /^~/;
1888 $path =~ s:^~([^/]+):(getpwnam($1))[$[+7]:e; # ~name
1889 $path =~ s:^~:$ENV{'HOME'} || (getpwuid($<))[$[+7]:e; # ~
1893 # Set up profile components into %Profile, add any profile-supplied options
1894 # into @ARGV and return the command invocation name.
1896 local($profile) = &tilda_expand($ENV{'DIST'} || '~/.dist_profile');
1897 local($me) = $0; # Command name
1898 $me =~ s|.*/(.*)|$1|; # Keep only base name
1899 return $me unless -s $profile;
1900 local(*PROFILE); # Local file descriptor
1901 local($options) = ''; # Options we get back from profile
1902 unless (open(PROFILE, $profile)) {
1903 warn "$me: cannot open $profile: $!\n";
1909 next if /^\s*#/; # Skip comments
1910 next unless /^$me/o;
1911 if (s/^$me://o) { # progname: options
1913 $options .= $_; # Merge options if more than one line
1915 elsif (s/^$me-([^:]+)://o) { # progname-component: value
1918 s/^\s+//; # Trim leading and trailing spaces
1920 $Profile{$component} = $_;
1924 return unless $options;
1925 require 'shellwords.pl';
1927 eval '@opts = &shellwords($options)'; # Protect against mismatched quotes
1928 unshift(@ARGV, @opts);
1929 return $me; # Return our invocation name