4 BEGIN { $ENV{LC_ALL} = "C"; }
9 $p5_metaconfig_base = "$FindBin::Bin/../";
10 chdir "$p5_metaconfig_base/perl" or
11 die "perl/ directory missing in $p5_metaconfig_base\n";
13 -w 'Configure' && -w 'config_h.SH' or
14 die "both Configure and config_h.SH must be writable\n";
16 -l '.package' && -l 'U' or
17 die ".package and U should be symlinks as per README\n";
19 # $Id: mconfig.SH 22 2008-05-28 08:01:59Z rmanfredi $
21 # Copyright (c) 1991-1997, 2004-2006, Raphael Manfredi
23 # You may redistribute only under the terms of the Artistic Licence,
24 # as specified in the README file that comes with the distribution.
25 # You may reuse parts of this distribution only within the terms of
26 # that same Artistic Licence; a copy of which may be found at the root
27 # of the source tree for dist 4.0.
29 # Original Author: Larry Wall <lwall@netlabs.com>
30 # Key Contributor: Harlan Stenn <harlan@mumps.pfcs.com>
32 # $Log: mconfig.SH,v $
33 # Revision 3.0.1.5 1995/07/25 14:19:05 ram
34 # patch56: new -G option
36 # Revision 3.0.1.4 1994/06/20 07:11:04 ram
37 # patch30: new -L option to override public library path for testing
39 # Revision 3.0.1.3 1994/01/24 14:20:53 ram
40 # patch16: added ~/.dist_profile awareness
42 # Revision 3.0.1.2 1993/10/16 13:53:10 ram
43 # patch12: new -M option for magic symbols and confmagic.h production
45 # Revision 3.0.1.1 1993/08/19 06:42:26 ram
46 # patch1: leading config.sh searching was not aborting properly
48 # Revision 3.0 1993/08/18 12:10:17 ram
49 # Baseline for dist 3.0 netwide release.
54 $MC = "$p5_metaconfig_base/dist";
57 $grep = '/usr/bin/grep';
59 &profile; # Read ~/.dist_profile
60 &usage unless getopts("dhkmoOstvwGMVL:X:");
63 read_exclusions($opt_X);
64 $MC = $opt_L if $opt_L; # May override public library path
65 $MC = &tilda_expand($MC); # ~name expansion
66 chop($WD = `pwd`); # Working directory
67 chdir $MC || die "Can't chdir to $MC: $!\n";
68 chop($MC = `pwd`); # Real metaconfig lib path (no symbolic links)
69 chdir $WD || die "Can't chdir back to $WD: $!\n";
72 ++$opt_M if -f 'confmagic.h'; # Force -M if confmagic.h already there
75 print STDERR "metaconfig $version PL$patchlevel\n";
81 unlink 'Wanted' unless $opt_w; # Wanted rebuilt if no -w
82 unlink 'Obsolete' unless $opt_w; # Obsolete file rebuilt if no -w
83 &readpackage; # Merely get the package's name
84 &init; # Various initializations
85 `mkdir .MT 2>&1` unless -d '.MT'; # For private temporary files
87 &locate_units; # Fill in @ARGV with a unit list
88 &extract_dependencies; # Extract dependencies from units
89 &extract_filenames; # Extract files to be scanned for
90 &build_wanted; # Build a list of wanted symbols in file Wanted
91 &build_makefile; # To do the transitive closure of dependencies
92 &solve_dependencies; # Now run the makefile to close dependency graph
93 &create_configure; # Create the Configure script and related files
94 &cosmetic_update; # Update the manifests
97 print "Leaving subdirectory .MT unremoved so you can peruse it.\n"
102 system $^X, "Porting/config_h.pl";
103 print "Done.\n" unless $opt_s;
105 # General initializations
107 &init_except; # Token which have upper-cased letters
108 &init_keep; # The keep status for built-in interpreter
109 &init_priority; # Priorities for diadic operators
110 &init_constants; # Define global constants
111 &init_depend; # The %Depend array records control line handling
115 $NEWMANI = 'MANIFEST.new'; # List of files to be scanned
116 $MANI = 'MANIFEST'; # For manifake
118 # The distinction between MANIFEST.new and MANIFEST can make sense
119 # when the "pat" tools are used, but if only metaconfig is used, then
120 # we can very well leave without a MANIFEST.new. --RAM, 2006-08-25
121 $NEWMANI = $MANI if -f $MANI && ! -f $NEWMANI;
124 # Record the exceptions -- almost all symbols but these are lower case
125 # We also use three symbols from Unix.U for default file suffixes.
133 $Except{'RCSfile'}++;
134 $Except{'Revision'}++;
142 # Print out metaconfig's usage and exits
144 print STDERR <<'EOH';
145 Usage: metaconfig [-dhkmostvwGMV] [-L dir] [-X file]
147 -h : print this help message and exits.
148 -k : keep temporary directory.
149 -m : assume lots of memory and swap space.
150 -o : maps obsolete symbols on new ones.
152 -t : trace symbols as they are found.
154 -w : trust Wanted file as being up-to-date.
155 -G : also provide a GNU configure-like front end.
156 -L : specify main units repository.
157 -M : activate production of confmagic.h.
158 -V : print version number and exits.
159 -X : read symbol exclusions from file (overriding .package)
166 # Locate the units and push their path in @ARGV (sorted alphabetically)
167 sub main'locate_units {
168 print "Locating units...\n" unless $main'opt_s;
169 local(*WD) = *main'WD; # Current working directory
170 local(*MC) = *main'MC; # Public metaconfig library
171 undef %myUlist; # Records private units paths
172 undef %myUseen; # Records private/public conflicts
173 &private_units; # Locate private units in @myUlist
174 &public_units; # Locate public units in @ARGV
175 @ARGV = sort @ARGV; # Sort it alphabetically
176 push(@ARGV, sort @myUlist); # Append user's units sorted
177 &dump_list if $main'opt_v; # Dump the list of units
180 # Dump the list of units on stdout
191 return unless -d 'U'; # Nothing to be done if no 'U' entry
192 local(*ARGV) = *myUlist; # Really fill in @myUlist
193 local($MC) = $WD; # We are really in the working directory
194 &units_path("U"); # Locate units in the U directory
195 local($unit_name); # Unit's name (without .U)
196 local(@kept); # Array of kept units
197 # Loop over the units and remove duplicates (the first one seen is the one
198 # we keep). Also set the %myUseen H table to record private units seen.
200 ($unit_name) = m|^.*/(.*)\.U$|; # Get unit's name from path
201 next if $myUseen{$unit_name}; # Already recorded
202 $myUseen{$unit_name} = 1; # Record pirvate unit
203 push(@kept, $_); # Keep this unit
210 chdir($MC) || die "Can't find directory $MC.\n";
211 &units_path("U"); # Locate units in public U directory
212 chdir($WD) || die "Can't go back to directory $WD.\n";
213 local($path); # Relative path from $WD
214 local($unit_name); # Unit's name (without .U)
215 local(*Unit) = *main'Unit; # Unit is a global from main package
216 local(@kept); # Units kept
217 local(%warned); # Units which have already issued a message
218 # Loop over all the units and keep only the ones that were not found in
219 # the user's U directory. As it is possible two or more units with the same
222 ($unit_name) = m|^.*/(.*)\.U$|; # Get unit's name from path
223 next if $warned{$unit_name}; # We have already seen this unit
224 $warned{$unit_name} = 1; # Remember we have warned the user
225 if ($myUseen{$unit_name}) { # User already has a private unit
226 $path = $Unit{$unit_name}; # Extract user's unit path
227 next if $path eq $_; # Same path, we must be in mcon/
228 $path =~ s|^$WD/||o; # Weed out leading working dir path
230 print " Your private $path overrides the public one.\n"
233 push(@kept, $_); # We may keep this one
239 # Recursively locate units in the directory. Each file ending with .U has to be
240 # a unit. Others are stat()'ed, and if they are a directory, they are also
241 # scanned through. The $MC and @ARGV variable are dynamically set by the caller.
243 local($dir) = @_; # Directory where units are to be found
244 local(@contents); # Contents of the directory
245 local($unit_name); # Unit's name, without final .U
246 local($path); # Full path of a unit
247 local(*Unit) = *main'Unit; # Unit is a global from main package
248 unless (opendir(DIR, $dir)) {
249 warn("Cannot open directory $dir.\n");
252 print "Locating in $MC/$dir...\n" if $main'opt_v;
253 @contents = readdir DIR; # Slurp the whole thing
254 closedir DIR; # And close dir, ready for recursion
255 foreach (sort @contents) {
256 next if $_ eq '.' || $_ eq '..';
257 if (/\.U$/) { # A unit, definitely
258 ($unit_name) = /^(.*)\.U$/;
259 $path = "$MC/$dir/$_"; # Full path of unit
260 push(@ARGV, $path); # Record its path
261 if (defined $Unit{$unit_name}) { # Already seen this unit
263 ($path) = $Unit{$unit_name} =~ m|^(.*)/.*|;
264 print " We've already seen $unit_name.U in $path.\n";
267 $Unit{$unit_name} = $path; # Map name to path
271 # We have found a file which does not look like a unit. If it is a
272 # directory, then scan it. Otherwise skip the file.
273 unless (-d "$dir/$_") {
274 print " Skipping file $_ in $dir.\n" if $main'opt_v;
277 &units_path("$dir/$_");
278 print "Back to $MC/$dir...\n" if $main'opt_v;
284 # Initialize the extraction process by setting some variables.
285 # We return a string to be eval to do more customized initializations.
286 sub init_extraction {
287 open(INIT, ">$WD/.MT/Init.U") ||
288 die "Can't create .MT/Init.U\n";
289 open(CONF_H, ">$WD/.MT/Config_h.U") ||
290 die "Can't create .MT/Config_h.U\n";
291 open(EXTERN, ">$WD/.MT/Extern.U") ||
292 die "Can't create .MT/Extern.U\n";
293 open(MAGIC_H, ">$WD/.MT/Magic_h.U") ||
294 die "Can't create .MT/Magic_h.U\n";
296 $c_symbol = ''; # Current symbol seen in ?C: lines
297 $s_symbol = ''; # Current symbol seen in ?S: lines
298 $m_symbol = ''; # Current symbol seen in ?M: lines
299 $heredoc = ''; # Last "here" document symbol seen
300 $heredoc_nosubst = 0; # True for <<'EOM' here docs
301 $condlist = ''; # List of conditional symbols
302 $defined = ''; # List of defined symbols in the unit
303 $body = ''; # No procedure to handle body
304 $ending = ''; # No procedure to clean-up
307 # End the extraction process
309 close EXTERN; # External dependencies (libraries, includes...)
310 close CONF_H; # C symbol definition template
311 close INIT; # Required initializations
312 close MAGIC; # Magic C symbol redefinition templates
314 print $dependencies if $opt_v; # Print extracted dependencies
317 # Process the ?MAKE: line
320 local(@ary); # Locally defined symbols
321 local(@dep); # Dependencies
322 if (/^[\w+ ]*:/) { # Main dependency rule
323 s|^\s*||; # Remove leading spaces
326 @dep = split(' ', $1); # Dependencies
327 @ary = split(' '); # Locally defined symbols
328 foreach $sym (@ary) {
329 # Symbols starting with a '+' are meant for internal use only.
330 next if $sym =~ s/^\+//;
331 # Only sumbols starting with a lowercase letter are to
332 # appear in config.sh, excepted the ones listed in Except.
333 if ($sym =~ /^[_a-z]/ || $Except{$sym}) {
334 $shmaster{"\$$sym"} = undef;
335 push(@Master,"?$unit:$sym=''\n"); # Initializations
338 $condlist = ''; # List of conditional symbols
339 local($sym); # Symbol copy, avoid @dep alteration
340 foreach $dep (@dep) {
341 if ($dep =~ /^\+[A-Za-z]/) {
342 ($sym = $dep) =~ s|^\+||;
343 $condlist .= "$sym ";
344 push(@Cond, $sym) unless $condseen{$sym};
345 $condseen{$sym}++; # Conditionally wanted
348 # Append to already existing dependencies. The 'defined' variable
349 # is set for &write_out, used to implement ?L: and ?I: canvas. It is
350 # reset each time a new unit is parsed.
351 # NB: leading '+' for defined symbols (internal use only) have been
352 # removed at this point, but conditional dependencies still bear it.
353 $defined = join(' ', @ary); # Symbols defined by this unit
354 $dependencies .= $defined . ':' . join(' ', @dep) . "\n";
355 $dependencies .= " -cond $condlist\n" if $condlist;
357 $dependencies .= $_; # Building rules
361 # Process the ?O: line
364 $Obsolete{"$unit.U"} .= $_; # Message(s) to print if unit is used
367 # Process the ?S: lines
373 print " ?S: $s_symbol\n" if $opt_d;
375 warn "\"$file\", line $.: syntax error in ?S: construct.\n";
379 # Deal with obsolete symbol list (enclosed between parenthesis)
380 &record_obsolete("\$$_") if /\(/;
382 m|^\.\s*$| && ($s_symbol = ''); # End of comment
385 # Process the ?C: lines
389 if (s/^(\w+)\s*~\s*(\S+)\s*(.*):/$1 $3:/) {
390 # The ~ operator aliases the main C symbol to another symbol which
391 # is to be used instead for definition in config.h. That is to say,
392 # the line '?C:SYM ~ other:' would look for symbol 'other' instead,
393 # and the documentation for symbol SYM would only be included in
394 # config.h if 'other' were actually wanted.
395 $c_symbol = $2; # Alias for definition in config.h
396 print " ?C: $1 ~ $c_symbol\n" if $opt_d;
397 } elsif (/^(\w+).*:/) {
398 # Default behaviour. Include in config.h if symbol is needed.
400 print " ?C: $c_symbol\n" if $opt_d;
402 warn "\"$file\", line $.: syntax error in ?C: construct.\n";
406 # Deal with obsolete symbol list (enclosed between parenthesis) and
407 # make sure that list do not appear in config.h.SH by removing it.
408 &record_obsolete("$_") if /\(/;
409 s/\s*\(.*\)//; # Get rid of obsolete symbol list
411 s|^(\w+)\s*|?$c_symbol:/* $1| || # Start of comment
412 (s|^\.\s*$|?$c_symbol: */\n| && ($c_symbol = '', 1)) || # End of comment
413 s|^(.*)|?$c_symbol: *$1|; # Middle of comment
414 &p_config("$_"); # Add comments to config.h.SH
417 # Process the ?H: lines
420 local($constraint); # Constraint to be used for inclusion
421 ++$old_version if s/^\?%1://; # Old version
422 if (s/^\?(\w+)://) { # Remove leading '?var:'
423 $constraint = $1; # Constraint is leading '?var'
425 $constraint = ''; # No constraint
427 if (/^#.*\$/) { # Look only for cpp lines
428 if (m|^#\$(\w+)\s+(\w+).*\$(\w+)|) {
429 # Case: #$d_var VAR "$var"
430 $constraint = $2 unless $constraint;
431 print " ?H: ($constraint) #\$$1 $2 \"\$$3\"\n" if $opt_d;
432 $cmaster{$2} = undef;
433 $cwanted{$2} = "$1\n$3";
434 } elsif (m|^#define\s+(\w+)\((.*)\)\s+\$(\w+)|) {
435 # Case: #define VAR(x) $var
436 $constraint = $1 unless $constraint;
437 print " ?H: ($constraint) #define $1($2) \$$3\n" if $opt_d;
438 $cmaster{$1} = undef;
440 } elsif (m|^#\$define\s+(\w+)|) {
442 $constraint = $1 unless $constraint;
443 print " ?H: ($constraint) #define $1\n" if $opt_d;
444 $cmaster{$1} = undef;
445 $cwanted{$1} = "define\n$unit";
446 } elsif (m|^#\$(\w+)\s+(\w+)|) {
448 $constraint = $2 unless $constraint;
449 print " ?H: ($constraint) #\$$1 $2\n" if $opt_d;
450 $cmaster{$2} = undef;
452 } elsif (m|^#define\s+(\w+).*\$(\w+)|) {
453 # Case: #define VAR "$var"
454 $constraint = $1 unless $constraint;
455 print " ?H: ($constraint) #define $1 \"\$$2\"\n" if $opt_d;
456 $cmaster{$1} = undef;
459 $constraint = $unit unless $constraint;
460 print " ?H: ($constraint) $_" if $opt_d;
463 print " ?H: ($constraint) $_" if $opt_d;
465 # If not a single ?H:. line, add the leading constraint
466 s/^\.// || s/^/?$constraint:/;
470 # Process the ?M: lines
474 if (/^(\w+):\s*([\w\s]*)\n$/) {
475 # A '?M:sym:' line implies a '?W:%<:sym' since we'll need to know
476 # about the wantedness of sym later on when building confmagic.h.
477 # Buf is sym is wanted, then the C symbol dependencies have to
478 # be triggered. That is done by introducing sym in the mwanted
479 # array, known by the Wanted file construction process...
481 print " ?M: $m_symbol\n" if $opt_d;
482 $mwanted{$m_symbol} = $2; # Record C dependencies
483 &p_wanted("$unit:$m_symbol"); # Build fake ?W: line
485 warn "\"$file\", line $.: syntax error in ?M: construct.\n";
489 (s/^\.\s*$/?$m_symbol:\n/ && ($m_symbol = '', 1)) || # End of block
491 print MAGIC_H; # Definition goes to confmagic.h
492 print " ?M: $_" if $opt_d;
495 sub p_ignore {} # Ignore comment line
496 sub p_lint {} # Ignore lint directives
497 sub p_visible {} # No visible checking in metaconfig
498 sub p_temp {} # No temporary variable control
499 sub p_file {} # Ignore produced file directives (for now)
501 # Process the ?W: lines
503 # Syntax is ?W:<shell symbols>:<C symbols>
504 local($active) = $_[0] =~ /^([^:]*):/; # Symbols to activate
505 local($look_symbols) = $_[0] =~ /:(.*)/; # When those are used
506 local(@syms) = split(/ /, $look_symbols); # Keep original spacing info
507 $active =~ s/\s+/\n/g; # One symbol per line
509 # Concatenate quoted strings, so saying something like 'two words' will
510 # be introduced as one single symbol "two words".
511 local(@symbols); # Concatenated symbols to look for
512 local($concat) = ''; # Concatenation buffer
517 push(@symbols, $concat . ' ' . $_);
520 push(@symbols, $_) unless $concat;
521 $concat .= ' ' . $_ if $concat;
525 # Now record symbols in master and wanted tables
527 $cmaster{$_} = undef; # Asks for look-up in C files
528 $cwanted{$_} = "$active" if $active; # Shell symbols to activate
531 delete @cmaster{keys %excluded_symbol};
532 delete @cwanted{keys %excluded_symbol};
535 # Process the ?INIT: lines
538 print INIT "?$unit:", $_; # Wanted only if unit is loaded
541 # Process the ?D: lines
544 s/^([A-Za-z_]+)=(.*)/\@if !$1\n%$1:$1=$2\n\@define $1\n\@end/
545 && ($hasdefault{$1}++, print INIT $_);
548 # Process the ?P: lines
551 local($csym); # C symbol(s) we're trying to look at
552 local($nosym); # List of symbol(s) which mustn't be wanted
553 local($cfile); # Name of file implementing csym (no .ext)
554 ($csym, $nosym, $cfile) = /([^()]+)\s*(\(.*\))\s*:\s*(\S+)/;
555 unless ($csym eq '' || $cfile eq '') {
556 # Add dependencies for each C symbol, of the form:
557 # -pick public <sym> <file> <notdef symbols list>
558 # and the file will be added to config.c whenever sym is wanted and
559 # none of the notdef symbols is wanted.
560 foreach $sym (split(' ', $csym)) {
561 $dependencies .= "\t-pick public $sym $cfile $nosym\n";
566 # Process the ?Y: lines
567 # Valid layouts are for now are: top, bottom, default.
570 # This routine relies on the $defined variable, a global variable set
571 # during the ?MAKE: processing, which lists all the defined symbols in
572 # the unit (the optional leading '+' for internal symbols has been removed
575 # The routine fills up a %Layout table, indexed by symbol, yielding the
576 # layout imposed to this unit. That table will then be used later on when
577 # we sort wanted symbols for the Makefile.
580 local($layout) = /^\s*(\w+)/;
581 $layout =~ tr/A-Z/a-z/; # Case is not significant for layouts
582 unless (defined $Lcmp{$layout}) {
583 warn "\"$file\", line $.: unknown layout directive '$layout'.\n";
586 foreach $sym (split(' ', $defined)) {
587 $Layout{$sym} = $Lcmp{$layout};
591 # Process the ?L: lines
592 # There should not be any '-l' in front of the library name
597 # Process the ?I: lines
602 # Write out line in file Extern.U. The information recorded there has the
603 # following prototypical format:
605 # If 'symbol' is wanted, then 'inet bsd' will be added to $libswanted.
608 local($target) = $defined; # By default, applies to defined symbols
609 $target = $1 if s/^(.*)://; # List is qualified "?L:target:symbols"
610 local(@target) = split(' ', $target);
612 foreach $key (@target) {
613 print EXTERN "?$key:$_\n"; # EXTERN file defined in xref.pl
617 # The %Depend array records the functions we use to process the configuration
618 # lines in the unit, with a special meaning. It is important that all the
619 # known control symbols be listed below, so that metalint does not complain.
620 # The %Lcmp array contains valid layouts and their comparaison value.
623 'MAKE', 'p_make', # The ?MAKE: line records dependencies
624 'INIT', 'p_init', # Initializations printed verbatim
625 'LINT', 'p_lint', # Hints for metalint
626 'RCS', 'p_ignore', # RCS comments are ignored
627 'C', 'p_c', # C symbols
628 'D', 'p_default', # Default value for conditional symbols
629 'E', 'p_example', # Example of usage
630 'F', 'p_file', # Produced files
631 'H', 'p_config', # Process the config.h lines
632 'I', 'p_include', # Added includes
633 'L', 'p_library', # Added libraries
634 'M', 'p_magic', # Process the confmagic.h lines
635 'O', 'p_obsolete', # Unit obsolescence
636 'P', 'p_public', # Location of PD implementation file
637 'S', 'p_shell', # Shell variables
638 'T', 'p_temp', # Shell temporaries used
639 'V', 'p_visible', # Visible symbols like 'rp', 'dflt'
640 'W', 'p_wanted', # Wanted value for interpreter
641 'X', 'p_ignore', # User comment is ignored
642 'Y', 'p_layout', # User-defined layout preference
651 # Extract dependencies from units held in @ARGV
652 sub extract_dependencies {
653 local($proc); # Procedure used to handle a ctrl line
654 local($file); # Current file scanned
655 local($dir, $unit); # Directory and unit's name
656 local($old_version) = 0; # True when old-version unit detected
657 local($mc) = "$MC/U"; # Public metaconfig directory
658 local($line); # Last processed line for metalint
660 printf "Extracting dependency lists from %d units...\n", $#ARGV+1
663 chdir $WD; # Back to working directory
664 &init_extraction; # Initialize extraction files
665 $dependencies = ' ' x (50 * @ARGV); # Pre-extend
668 # We do not want to use the <> construct here, because we need the
669 # name of the opened files (to get the unit's name) and we want to
670 # reset the line number for each files, and do some pre-processing.
672 file: while ($file = shift(@ARGV)) {
673 close FILE; # Reset line number
674 $old_version = 0; # True if unit is an old version
675 if (open(FILE, $file)) {
676 ($dir, $unit) = ('', $file)
677 unless ($dir, $unit) = ($file =~ m|(.*)/(.*)|);
678 $unit =~ s|\.U$||; # Remove extension
680 warn("Can't open $file.\n");
682 # If unit is in the standard public directory, keep only the unit name
683 $file = "$unit.U" if $dir eq $mc;
684 print "$dir/$unit.U:\n" if $opt_d;
685 line: while (<FILE>) {
686 $line = $_; # Save last processed unit line
687 if (s/^\?([\w\-]+)://) { # We may have found a control line
688 $proc = $Depend{$1}; # Look for a procedure to handle it
689 unless ($proc) { # Unknown control line
690 $proc = $1; # p_unknown expects symbol in '$proc'
691 eval '&p_unknown'; # Signal error (metalint only)
692 next line; # And go on next line
694 # Long lines may be escaped with a final backslash
695 $_ .= &complete_line(FILE) if s/\\\s*$//;
696 # Run macros substitutions
697 s/%</$unit/g; # %< expands into the unit's name
699 # %* expanded into the entire set of defined symbols
700 # in the old version. Now it is only the unit's name.
703 eval { &$proc($_) }; # Process the line
705 next file unless $body; # No procedure to handle body
707 $line = $_; # Save last processed unit line
708 eval { &$body($_) } ; # From now on, it's the unit body
709 } while (defined ($_ = <FILE>));
714 warn(" Warning: $file is a pre-3.0 version.\n") if $old_version;
715 &$ending($line) if $ending; # Post-processing for metalint
718 &end_extraction; # End the extraction process
721 # The first line was escaped with a final \ character. Every following line
722 # is to be appended to it (until we found a real \n not escaped). Note that
723 # the leading spaces of the continuation line are removed, so any space should
724 # be added before the former \ if needed.
726 local($file) = @_; # File where lines come from
728 local($read) = ''; # Concatenation of all the continuation lines found
730 s/^\s+//; # Remove leading spaces
731 if (s/\\\s*$//) { # Still followed by a continuation line
733 } else { # We've reached the end of the continuation
739 # Extract filenames from manifest
740 sub extract_filenames {
741 &build_filext; # Construct &is_cfile and &is_shfile
742 print "Extracting filenames (C and SH files) from $NEWMANI...\n"
744 open(NEWMANI,$NEWMANI) || die "Can't open $NEWMANI.\n";
747 ($file) = split(' ');
748 next if $file eq 'config_h.SH'; # skip config_h.SH
749 next if $file eq 'Configure'; # also skip Configure
750 next if $file eq 'confmagic.h' && $opt_M;
751 push(@SHlist, $file) if &is_shfile($file);
752 push(@clist, $file) if &is_cfile($file);
756 # Construct two file identifiers based on the file suffix: one for C files,
757 # and one for SH files (using the $cext and $shext variables) defined in
759 # The &is_cfile and &is_shfile routine may then be called to known whether
760 # a given file is a candidate for holding C or SH symbols.
762 &build_extfun('is_cfile', $cext, '.c .h .y .l');
763 &build_extfun('is_shfile', $shext, '.SH');
766 # Build routine $name to identify extensions listed in $exts, ensuring
767 # that $minimum is at least matched (both to be backward compatible with
768 # older .package and because it is really the minimum requirred).
770 local($name, $exts, $minimum) = @_;
771 local(@single); # Single letter dot extensions (may be grouped)
772 local(@others); # Other extensions
773 local(%seen); # Avoid duplicate extensions
774 foreach $ext (split(' ', "$exts $minimum")) {
775 next if $seen{$ext}++;
776 if ($ext =~ s/^\.(\w)$/$1/) {
779 # Convert into perl's regexp
780 $ext =~ s/\./\\./g; # Escape .
781 $ext =~ s/\?/./g; # ? turns into .
782 $ext =~ s/\*/.*/g; # * turns into .*
786 local($fn) = &q(<<EOF); # Function being built
790 local($single); # Single regexp: .c .h grouped into .[ch]
791 $single = '\.[' . join('', @single) . ']' if @single;
792 $fn .= &q(<<EOL) if @single;
793 : return 1 if /$single\$/;
795 foreach $ext (@others) {
797 : return 1 if /$ext\$/;
801 : 0; # None of the extensions may be applied to file name
806 chop($@) && die "Can't compile '$name':\n$fn\n$@.\n";
809 # Remove ':' quotations in front of the lines
816 sub read_exclusions {
818 if (!defined $filename) {
819 $filename = $exclusions_file; # default to name from .package
820 return if !defined $filename || $filename eq '';
822 print "Reading exclusions from $filename...\n" unless $opt_s;
823 open(EXCLUSIONS, "< $filename\0") || die "Can't read $filename: $!\n";
825 while (<EXCLUSIONS>) {
827 # comment or blank line, ignore
829 elsif (/^\s*(\w+)\s*$/) {
830 $excluded_symbol{$1} = 1;
833 die "$filename:$.: unrecognised line\n";
836 close(EXCLUSIONS) || die "Can't close $filename: $!\n";
839 # Build a wanted file from the files held in @SHlist and @clist arrays
841 # If wanted file is already there, parse it to map obsolete if -o option
842 # was used. Otherwise, build a new one.
844 &map_obsolete if $opt_o; # Build Obsol*.U files
845 &dump_obsolete; # Dump obsolete symbols if any
852 print "Building a Wanted file...\n" unless $opt_s;
853 open(WANTED,"| sort | uniq >Wanted") || die "Can't create Wanted.\n";
854 unless (-f $NEWMANI) {
856 die "No $NEWMANI--can't build a Wanted file.\n" unless -f $NEWMANI;
859 local($search); # Where to-be-evaled script is held
860 local($_) = ' ' x 50000 if $opt_m; # Pre-extend pattern search space
861 local(%visited); # Records visited files
862 local(%lastfound); # Where last occurence of key was
864 # Now we are a little clever, and build a loop to eval so that we don't
865 # have to recompile our patterns on every file. We also use "study" since
866 # we are searching the same string for many different things. Hauls!
869 local($others) = $cext ? " $cext" : '';
870 print " Scanning .[chyl]$others files for symbols...\n"
872 $search = ' ' x (40 * (@cmaster + @ocmaster)); # Pre-extend
873 $search = "while (<>) {study;\n"; # Init loop over ARGV
874 foreach $key (keys(%cmaster)) {
875 $search .= "&cmaster('$key') if /\\b$key\\b/;\n";
877 foreach $key (grep(!/^\$/, keys %Obsolete)) {
878 $search .= "&ofound('$key') if /\\b$key\\b/;\n";
880 $search .= "}\n"; # terminate loop
881 print $search if $opt_d;
883 # Swallow each file as a whole, if memory is available
888 while (($key,$value) = each(%cmaster)) {
889 print WANTED $cwanted{$key}, "\n", ">$key", "\n" if $value;
893 # If they don't use magic but use magically guarded symbols without
894 # their corresponding C symbol dependency, warn them, since they might
895 # not know about that portability issue.
897 if (@clist && !$opt_M) {
898 local($nused); # list of non-used symbols
899 local($warning) = 0; # true when one warning issued
900 foreach $cmag (keys %mwanted) { # loop over all used magic symbols
901 next unless $cmaster{$cmag};
903 foreach $cdep (split(' ', $mwanted{$cmag})) {
904 $nused .= " $cdep" unless $cmaster{$cdep};
907 $nused = "one of " . $nused if $nused =~ s/ /, /g;
909 print " Warning: $cmag is used without $nused.\n";
914 local($those) = $warning == 1 ? 'that' : 'those';
915 local($s) = $warning == 1 ? '' : 's';
916 print "Note: $those previous warning$s may be suppressed by -M.\n";
920 # Cannot remove $cmaster as it is used later on when building Configure
928 local($others) = $shext ? " $shext" : '';
929 print " Scanning .SH$others files for symbols...\n" unless $opt_s;
930 $search = ' ' x (40 * (@shmaster + @oshmaster)); # Pre-extend
931 $search = "while (<>) {study;\n";
932 # All the keys already have a leading '$'
933 foreach $key (keys(%shmaster)) {
934 $search .= "&shmaster('$key') if /\\$key\\b/;\n";
936 foreach $key (grep (/^\$/, keys %Obsolete)) {
937 $search .= "&ofound('$key') if /\\$key\\b/;\n";
940 print $search if $opt_d;
942 # Swallow each file as a whole, if memory is available
947 while (($key,$value) = each(%shmaster)) {
950 print WANTED $key, "\n";
955 # Obsolete symbols, if any, are written in the Wanted file preceded by a
956 # '!' character. In case -w is used, we'll thus be able to correctly build
957 # the Obsol_h.U and Obsol_sh.U files.
959 &add_obsolete; # Add obsolete symbols in Wanted file
963 # If obsolete symbols where found, write an Obsolete file which lists where
964 # each of them appear and the new symbol to be used. Also write Obsol_h.U
965 # and Obsol_sh.U in .MT for later perusal.
967 &dump_obsolete; # Dump obsolete symbols if any
969 die "No desirable symbols found--aborting.\n" unless -s 'Wanted';
971 # Clean-up memory by freeing useless data structures
976 # This routine records matches of C master keys
979 $cmaster{$key}++; # This symbol is wanted
980 return unless $opt_t || $opt_M; # Return if neither -t nor -M
982 $lastfound{$key} ne $ARGV # Never mentionned for this file ?
984 $visited{$ARGV}++ || print $ARGV,":\n";
986 $lastfound{$key} = $ARGV;
989 defined($mwanted{$key}) # Found a ?M: symbol
991 foreach $csym (split(' ', $mwanted{$key})) {
992 $cmaster{$csym}++; # Activate C symbol dependencies
997 # This routine records matches of obsolete keys (C or shell)
1000 local($_) = $Obsolete{$key}; # Value of new symbol
1001 $ofound{"$ARGV $key $_"}++; # Record obsolete match
1002 $cmaster{$_}++ unless /^\$/; # A C hit
1003 $shmaster{$_}++ if /^\$/; # Or a shell one
1004 return unless $opt_t; # Continue if trace option on
1005 if ($lastfound{$key} ne $ARGV) { # Never mentionned for this file ?
1006 $visited{$ARGV}++ || print $ARGV,":\n";
1007 print "\t$key (obsolete, use $_)\n";
1008 $lastfound{$key} = $ARGV;
1012 # This routine records matches of shell master keys
1015 $shmaster{$key}++; # This symbol is wanted
1016 return unless $opt_t; # Continue if trace option on
1017 if ($lastfound{$key} ne $ARGV) { # Never mentionned for this file ?
1018 $visited{$ARGV}++ || print $ARGV,":\n";
1020 $lastfound{$key} = $ARGV;
1024 # Write obsolete symbols into the Wanted file for later perusal by -w.
1026 local($file); # File where obsolete symbol was found
1027 local($old); # Name of this old symbol
1028 local($new); # Value of the new symbol to be used
1029 foreach $key (sort keys %ofound) {
1030 ($file, $old, $new) = ($key =~ /^(\S+)\s+(\S+)\s+(\S+)/);
1031 if ($new =~ s/^\$//) { # We found an obsolete shell symbol
1032 print WANTED "!$old\n";
1033 } else { # We found an obsolete C symbol
1034 print WANTED "!>$old\n";
1039 # Map obsolete symbols from Wanted file into %Obsolete and call dump_obsolete
1040 # to actually build the Obsol_sh.U and Obsol_h.U files. Those will be needed
1041 # during the Configure building phase to actually do the remaping.
1042 # The obsolete symbols found are entered in the %ofound array, tagged as from
1043 # file 'XXX', which is specially recognized by dump_obsolete.
1045 open(WANTED, 'Wanted') || die "Can't open Wanted file.\n";
1046 local($new); # New symbol to be used instead of obsolete one
1049 next unless s/^!//; # Skip non-obsolete symbols
1050 if (s/^>//) { # C symbol
1051 $new = $Obsolete{$_}; # Fetch new symbol
1052 $ofound{"XXX $_ $new"}++; # Record obsolete match (XXX = no file)
1053 } else { # Shell symbol
1054 $new = $Obsolete{"\$$_"}; # Fetch new symbol
1055 $ofound{"XXX \$$_ $new"}++; # Record obsolete match (XXX = no file)
1061 # Record obsolete symbols association (new versus old), that is to say for a
1062 # given old symbol, $Obsolete{'old'} = new symbol to be used. A '$' is prepended
1063 # for all shell variables
1064 sub record_obsolete {
1066 local(@obsoleted); # List of obsolete symbols
1067 local($symbol); # New symbol which must be used
1068 local($dollar) = s/^\$// ? '$':''; # The '$' or a null string
1069 # Syntax for obsolete symbols specification is
1070 # list of symbols (obsolete ones):
1071 if (/^(\w+)\s*\((.*)\)\s*:$/) {
1072 $symbol = "$dollar$1";
1073 @obsoleted = split(' ', $2); # List of obsolete symbols
1075 if (/^(\w+)\s*\((.*):$/) {
1076 warn "\"$file\", line $.: final ')' before ':' missing.\n";
1077 $symbol = "$dollar$1";
1078 @obsoleted = split(' ', $2);
1080 warn "\"$file\", line $.: syntax error.\n";
1084 foreach $val (@obsoleted) {
1085 $_ = $dollar . $val;
1086 if (defined $Obsolete{$_}) {
1087 warn "\"$file\", line $.: '$_' already obsoleted by '$Obsolete{$_}'.\n";
1089 $Obsolete{$_} = $symbol; # Record (old, new) tuple
1094 # Dump obsolete symbols used in file 'Obsolete'. Also write Obsol_h.U and
1095 # Obsol_sh.U to record old versus new mappings if the -o option was used.
1097 unless (-f 'Obsolete') {
1098 open(OBSOLETE, ">Obsolete") || die "Can't create Obsolete.\n";
1100 open(OBSOL_H, ">.MT/Obsol_h.U") || die "Can't create .MT/Obsol_h.U.\n";
1101 open(OBSOL_SH, ">.MT/Obsol_sh.U") || die "Can't create .MT/Obsol_sh.U.\n";
1102 local($file); # File where obsolete symbol was found
1103 local($old); # Name of this old symbol
1104 local($new); # Value of the new symbol to be used
1105 # Leave a blank line at the top so that anny added ^L will stand on a line
1106 # by itself (the formatting process adds a ^L when a new page is needed).
1107 format OBSOLETE_TOP =
1109 File | Old symbol | New symbol
1110 -----------------------------------+----------------------+---------------------
1113 @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< | @<<<<<<<<<<<<<<<<<<< | @<<<<<<<<<<<<<<<<<<<
1117 foreach $key (sort keys %ofound) {
1118 ($file, $old, $new) = ($key =~ /^(\S+)\s+(\S+)\s+(\S+)/);
1119 write(OBSOLETE) unless $file eq 'XXX';
1120 next unless $opt_o; # Obsolete mapping done only with -o
1121 next if $seen{$old}++; # Already remapped, thank you
1122 if ($new =~ s/^\$//) { # We found an obsolete shell symbol
1124 print OBSOL_SH "$old=\"\$$new\"\n";
1125 } else { # We found an obsolete C symbol
1126 print OBSOL_H "#ifdef $new\n";
1127 print OBSOL_H "#define $old $new\n";
1128 print OBSOL_H "#endif\n\n";
1134 if (-s 'Obsolete') {
1135 print "*** Obsolete symbols found -- see file 'Obsolete' for a list.\n";
1139 undef %ofound; # Not needed any more
1142 # Build the private makefile we use to compute the transitive closure of the
1143 # previously determined dependencies.
1144 sub build_makefile {
1145 print "Computing optimal dependency graph...\n" unless $opt_s;
1146 chdir('.MT') || die "Can't chdir to .MT\n";
1147 local($wanted); # Wanted shell symbols
1148 &build_private; # Build a first makefile from dependencies
1149 &compute_loadable; # Compute loadable units
1150 &update_makefile; # Update makefile using feedback from first pass
1151 chdir($WD) || die "Can't chdir back to $WD\n";
1152 # Free memory by removing useless data structures
1153 undef $dependencies;
1154 undef $saved_dependencies;
1157 # First pass: build a private makefile from the extracted dependency, changing
1158 # conditional units to truly wanted ones if the symbol is used, removing the
1159 # dependency otherwise. The original dependencies are saved.
1161 print " Building private make file...\n" unless $opt_s;
1162 open(WANTED,"../Wanted") || die "Can't reopen Wanted.\n";
1163 $wanted = ' ' x 2000; # Pre-extend string
1167 next if /^!/; # Skip obsolete symbols
1176 # The wanted symbols are sorted so that d_* (checking for C library symbol)
1177 # come first and i_* (checking for includes) comes at the end. Grouping the
1178 # d_* symbols together has good chances of improving the locality of the
1179 # other questions and i_* symbols must come last since some depend on h_*
1180 # values which prevent incompatible headers inclusions.
1181 $wanted = join(' ', sort symbols split(' ', $wanted));
1183 # Now generate the first makefile, which will be used to determine which
1184 # symbols we really need, so that conditional dependencies may be solved.
1185 open(MAKEFILE,">Makefile") || die "Can't create .MT/Makefile.\n";
1186 print MAKEFILE "SHELL = /bin/sh\n";
1187 print MAKEFILE "W = $wanted\n";
1188 $saved_dependencies = $dependencies;
1189 foreach $sym (@Cond) {
1190 if ($symwanted{$sym}) {
1191 $dependencies =~ s/\+($sym\s)/$1/gm;
1193 $dependencies =~ s/\+$sym(\s)/$1/gm;
1196 print MAKEFILE $dependencies;
1200 # Ordering for symbols. Give higher priority to d_* ones and lower to i_* ones.
1201 # If any layout priority is defined in %Layout, it is used to order the
1204 local($r) = $Layout{$a} <=> $Layout{$b};
1206 # If we come here, both symbols have the same layout priority.
1208 return -1 unless $b =~ /^d_/;
1209 } elsif ($b =~ /^d_/) {
1211 } elsif ($a =~ /^i_/) {
1212 return 1 unless $b =~ /^i_/;
1213 } elsif ($b =~ /^i_/) {
1219 # Run the makefile produced in the first pass to find the whole set of units we
1220 # have to load, filling in the %symwanted and %condwanted structures.
1221 sub compute_loadable {
1222 print " Determining loadable units...\n" unless $opt_s;
1223 open(MAKE, "make -n |") || die "Can't run make";
1225 s|^\s+||; # Some make print tabs before command
1227 print "\t$_" if $opt_v;
1228 ($pick,$cmd,$symbol,$unit) = split(' ');
1229 $symwanted{$symbol}++;
1230 $symwanted{$unit}++;
1232 print "\t$_" if $opt_v;
1233 ($pick,@symbol) = split(' ');
1235 $condwanted{$_}++; # Default value is requested
1242 # Now that we know all the desirable symbols, we have to rebuild
1243 # another makefile, in order to have the units in a more optimal
1245 # Actually, if we have both ?MAKE:a:+b and ?MAKE:d:b and 'd' is
1246 # wanted; then 'b' will be loaded. However, 'b' is a conditional
1247 # dependency for 'a', and it would be better if 'b' were loaded
1248 # before 'a' is, though this is not necessary.
1249 # It is hard to know that 'b' will be loaded *before* the first make.
1251 # Back to the original dependencies, make loadable units truly wanted ones and
1252 # remove optional ones.
1253 sub update_makefile {
1254 print " Updating make file...\n" unless $opt_s;
1255 open(MAKEFILE,">Makefile") || die "Can't create .MT/Makefile.\n";
1256 print MAKEFILE "SHELL = /bin/sh\n";
1257 print MAKEFILE "W = $wanted\n";
1258 foreach $sym (@Cond) {
1259 if ($symwanted{$sym}) {
1260 $saved_dependencies =~ s/\+($sym\s)/$1/gm;
1262 $saved_dependencies =~ s/\+$sym(\s)/$1/gm;
1265 print MAKEFILE $saved_dependencies;
1269 # Solve dependencies by saving the 'pick' command in @cmdwanted
1270 sub solve_dependencies {
1271 local(%unitseen); # Record already picked units (avoid duplicates)
1272 print "Determining the correct order for the units...\n" unless $opt_s;
1273 chdir('.MT') || die "Can't chdir to .MT: $!.\n";
1274 open(MAKE, "make -n |") || die "Can't run make";
1276 s|^\s+||; # Some make print tabs before command
1277 print "\t$_" if $opt_v;
1279 ($pick,$cmd,$symbol,$unit) = split(' ');
1280 push(@cmdwanted,"$cmd $symbol $unit")
1281 unless $unitseen{"$cmd:$unit"}++;
1283 # Ignore conditional symbol request
1289 chdir($WD) || die "Can't chdir to $WD: $!.\n";
1293 # Create the Configure script
1294 sub create_configure {
1295 print "Creating Configure...\n" unless $opt_s;
1296 open(CONFIGURE,">Configure") || die "Can't create Configure: $!\n";
1297 open(CONF_H,">config_h.SH") || die "Can't create config_h.SH: $!\n";
1299 open(MAGIC_H,">confmagic.h") || die "Can't create confmagic.h: $!\n";
1302 chdir('.MT') || die "Can't cd to .MT: $!\n";
1304 &process_command($_); # Run the makefile command
1306 chdir($WD) || die "Can't cd back to $WD\n";
1308 print CONF_H "#endif\n"; # Close the opened #ifdef (see Config_h.U)
1309 print CONF_H "!GROK!THIS!\n";
1312 print MAGIC_H "#endif\n"; # Close the opened #ifdef (see Magic_h.U)
1315 `chmod +x Configure`;
1318 # Process a Makefile 'pick' command
1319 sub process_command {
1320 local($cmd, $target, $unit_name) = split(' ', $_[0]);
1321 local($name) = $unit_name . '.U'; # Restore missing .U
1322 local($file) = $name; # Where unit is located
1323 unless ($file =~ m|^\./|) { # Unit produced earlier by metaconfig
1324 $file = $Unit{$unit_name}; # Fetch unit from U directory
1326 if (defined $Obsolete{$name}) { # Signal use of an obsolete unit
1327 warn "\tObsolete unit $name is used:\n";
1328 local(@msg) = split(/\n/, $Obsolete{$name});
1329 foreach $msg (@msg) {
1333 die "Can't open UNIT (name: $name, target: $target) $file.\n" unless open(UNIT, $file);
1334 print "\t$cmd $file\n" if $opt_v;
1335 &init_interp; # Initializes the interpreter
1337 # The 'add' command adds the unit to Configure.
1338 if ($cmd eq 'add') {
1340 print CONFIGURE unless &skipped || !&interpret($_);
1344 # The 'weed' command adds the unit to Configure, but
1345 # makes some tests for the lines starting with '?' or '%'.
1346 # These lines are kept only if the symbol is wanted.
1347 elsif ($cmd eq 'weed') {
1350 s/^\?\w+:// if $symwanted{$1};
1353 s/^%\w+:// if $condwanted{$1};
1355 print CONFIGURE unless &skipped || !&interpret($_);
1359 # The 'wipe' command adds the unit to Configure, but
1360 # also substitues some hardwired macros.
1361 elsif ($cmd eq 'wipe') {
1363 s/<PACKAGENAME>/$package/g;
1364 s/<MAINTLOC>/$maintloc/g;
1365 s/<VERSION>/$version/g; # This is metaconfig's version
1366 s/<PATCHLEVEL>/$patchlevel/g; # And patchlevel information
1368 s/<BASEREV>/$baserev/g;
1369 s/<\$(\w+)>/eval("\$$1")/ge; # <$var> -> $var substitution
1370 print CONFIGURE unless &skipped || !&interpret($_);
1374 # The 'add.Null' command adds empty initializations
1375 # to Configure for all the shell variable used.
1376 elsif ($cmd eq 'add.Null') {
1377 for (sort @Master) {
1379 s/^\?\w+:// if $symwanted{$1};
1381 print CONFIGURE unless &skipped;
1384 print CONFIGURE "$_=''\n"
1385 unless $symwanted{$_} || $hasdefault{$_};
1388 print CONFIGURE unless &skipped || !&interpret($_);
1390 print CONFIGURE "CONFIG=''\n\n";
1393 # The 'add.Config_sh' command fills in the production of
1394 # the config.sh script within Configure. Only the used
1395 # variable are added, the conditional ones are skipped.
1396 elsif ($cmd eq 'add.Config_sh') {
1398 print CONFIGURE unless &skipped || !&interpret($_);
1400 for (sort @Master) {
1402 # Can't use $shmaster, because config.sh must
1403 # also contain some internal defaults used by
1404 # Configure (e.g. nm_opt, libc, etc...).
1405 s/^\?\w+:// if $symwanted{$1};
1407 s/^(\w+)=''/$1='\$$1'/;
1408 print CONFIGURE unless &skipped;
1412 # The 'close.Config_sh' command adds the final EOT line at
1413 # the end of the here-document construct which produces the
1414 # config.sh file within Configure.
1415 elsif ($cmd eq 'close.Config_sh') {
1416 print CONFIGURE "EOT\n\n"; # Ends up file
1419 # The 'c_h_weed' command produces the config_h.SH file.
1420 # Only the necessary lines are kept. If no conditional line is
1421 # ever printed, then the file is useless and will be removed.
1422 elsif ($cmd eq 'c_h_weed') {
1426 s/^\?\w+:// if $cmaster{$1} || $symwanted{$1};
1428 unless (&skipped || !&interpret($_)) {
1430 print CONF_H "\n" if $printed;
1440 # The 'cm_h_weed' command produces the confmagic.h file.
1441 # Only the necessary lines are kept. If no conditional line is
1442 # ever printed, then the file is useless and will be removed.
1443 elsif ($cmd eq 'cm_h_weed') {
1448 s/^\?\w+:// if $cmaster{$1} || $symwanted{$1};
1450 unless (&skipped || !&interpret($_)) {
1452 print MAGIC_H "\n" if $printed;
1463 # The 'prepend' command will add the content of the target to
1464 # the current file (held in $file, the one which UNIT refers to),
1465 # if the file is not empty.
1466 elsif ($cmd eq 'prepend') {
1468 open(PREPEND, ">.prepend") ||
1469 die "Can't create .MT/.prepend.\n";
1470 open(TARGET, $Unit{$target}) ||
1471 die "Can't open Unit $Unit{$target}.\n";
1473 print PREPEND unless &skipped;
1475 print PREPEND <UNIT>; # Now add original file contents
1478 rename('.prepend', $file) ||
1479 die "Can't rename .prepend into $file.\n";
1485 die "Unrecognized command from Makefile: $cmd\n";
1487 &check_state; # Make sure there are no pending statements
1491 # Skip lines starting with ? or %, including all the following continuation
1492 # lines, if any. Return 0 if the line was not to be skipped, 1 otherwise.
1494 return 0 unless /^\?|^%/;
1495 &complete_line(UNIT) if /\\\s*$/; # Swallow continuation lines
1499 # Update the MANIFEST.new file if necessary
1500 sub cosmetic_update {
1501 # Check for an "empty" config_h.SH (2 blank lines only). This test relies
1502 # on the actual text held in Config_h.U. If the unit is modified, then the
1503 # following might need adjustments.
1504 local($blank_lines) = 0;
1506 open(CONF_H, 'config_h.SH') || die "Can't open config_h.SH\n";
1508 ++$blank_lines if /^$/;
1510 unlink 'config_h.SH' unless $blank_lines > 3;
1512 open(NEWMANI,$NEWMANI);
1514 /(\S+\s+)\S+/ && ($spaces = length($1)); # Spaces wanted
1516 $spaces = 29 if ($spaces < 12); # Default value
1517 open(NEWMANI,$NEWMANI);
1518 $/ = "\001"; # Swallow the whole file
1523 &mani_add('Configure', 'Portability tool', $spaces) unless /^Configure\b/m;
1524 &mani_add('config_h.SH', 'Produces config.h', $spaces)
1525 unless /^config_h\.SH\b/m || !-f 'config_h.SH';
1526 &mani_add('confmagic.h', 'Magic symbol remapping', $spaces)
1527 if $opt_M && !/^confmagic\.h\b/m;
1529 &mani_remove('config_h.SH') if /^config_h\.SH\b/m && !-f 'config_h.SH';
1530 &mani_remove('confmagic.h') if /^confmagic.h\b/m && !$opt_M;
1532 if ($opt_G) { # Want a GNU-like configure wrapper
1534 &mani_add('configure', 'GNU configure-like wrapper', $spaces)
1535 if !/^configure\s/m && -f 'configure';
1537 &mani_remove('configure') if /^configure\s/m && !-f 'configure';
1541 # Add file to MANIFEST.new, with properly indented comment
1543 local($file, $comment, $spaces) = @_;
1544 print "Adding $file to your $NEWMANI file...\n" unless $opt_s;
1545 open(NEWMANI, ">>$NEWMANI") || warn "Can't add $file to $NEWMANI: $!\n";
1546 local($blank) = ' ' x ($spaces - length($file));
1547 print NEWMANI "${file}${blank}${comment}\n";
1551 # Remove file from MANIFEST.new
1554 print "Removing $file from $NEWMANI...\n" unless $opt_s;
1555 unless (open(NEWMANI, ">$NEWMANI.x")) {
1556 warn "Can't create backup $NEWMANI copy: $!\n";
1559 unless (open(OLDMANI, $NEWMANI)) {
1560 warn "Can't open $NEWMANI: $!\n";
1565 print NEWMANI unless /^$file\b/
1569 rename("$NEWMANI.x", $NEWMANI) ||
1570 warn "Couldn't restore $NEWMANI from $NEWMANI.x\n";
1573 # Copy GNU-like configure wrapper to the package root directory
1575 if (-f "$MC/configure") {
1576 print "Copying GNU configure-like front end...\n" unless $opt_s;
1577 system "cp $MC/configure ./configure";
1578 `chmod +x configure`;
1580 warn "Can't locate $MC/configure: $!\n";
1584 package interpreter;
1586 # States used by our interpeter -- in sync with @Keep
1587 sub main'init_keep {
1588 # Status in which we keep lines -- $Keep[$status]
1589 @Keep = (0, 1, 1, 0, 1);
1591 # Available status ($status)
1599 # Priorities for operators -- magic numbers :-)
1600 sub main'init_priority {
1601 $Priority{'&&'} = 4;
1602 $Priority{'||'} = 3;
1605 # Initializes the state stack of the interpreter
1606 sub main'init_interp {
1611 # Print error messages -- asssumes $unit and $. correctly set.
1613 warn "\"$main'file\", line $.: @_.\n";
1616 # If some states are still in the stack, warn the user
1617 sub main'check_state {
1618 &error("one statement pending") if $#state == 1;
1619 &error("$#state statements pending") if $#state > 1;
1622 # Add a value on the stack, modified by all the monadic operators.
1623 # We use the locals @val and @mono from eval_expr.
1625 local($val) = shift(@_);
1626 while ($#mono >= 0) {
1627 # Cheat... the only monadic operator is '!'.
1634 # Execute a stacked operation, leave result in stack.
1635 # We use the locals @val and @op from eval_expr.
1636 # If the value stack holds only one operand, do nothing.
1638 return unless $#val > 0;
1639 local($op) = pop(@op);
1640 local($val1) = pop(@val);
1641 local($val2) = pop(@val);
1642 push(@val, eval("$val1 $op $val2") ? 1: 0);
1645 # Given an operator, either we add it in the stack @op, because its
1646 # priority is lower than the one on top of the stack, or we first execute
1647 # the stacked operations until we reach the end of stack or an operand
1648 # whose priority is lower than ours.
1649 # We use the locals @val and @op from eval_expr.
1651 local($op) = shift(@_); # Operator
1652 if (!$Priority{$op}) {
1653 &error("illegal operator $op");
1657 &error("missing first operand for '$op' (diadic operator)");
1660 # Because of the special behaviour of do-SUBR with the while modifier,
1661 # I'm using a while-BLOCK construct. I consider this to be a bug of perl
1662 # 4.0 PL19, although it is clearly documented in the man page.
1664 $Priority{$op[$#op]} > $Priority{$op} # Higher priority op
1665 && $#val > 0 # At least 2 values
1667 &execute; # Execute an higher priority stacked operation
1669 push(@op, $op); # Everything at higher priority has been executed
1673 # This is the heart of our little interpreter. Here, we evaluate
1674 # a logical expression and return its value.
1676 local(*expr) = shift(@_); # Expression to parse
1677 local(@val) = (); # Stack of values
1678 local(@op) = (); # Stack of diadic operators
1679 local(@mono) =(); # Stack of monadic operators
1683 s/^\s+//; # Remove spaces between words
1686 &push_val(&eval_expr(*_));
1687 # A final '\' indicates an end of line
1688 &error("missing final parenthesis") if !s/^\\//;
1690 # Found a ')' or end of line
1691 elsif (/^\)/ || /^$/) {
1692 s/^\)/\\/; # Signals: left parenthesis found
1693 $expr = $_; # Remove interpreted stuff
1694 &execute() while $#val > 0; # Executed stacked operations
1697 &error("missing second operand for '$_' (diadic operator)");
1701 # A perl statement '{{'
1703 if (s/^(.*)\}\}//) {
1705 ('perl','-e', "if ($1) {exit 0;} else {exit 1;}"
1708 &error("incomplete perl statement");
1711 # A shell statement '{'
1715 ("if $1 >/dev/null 2>&1; then exit 0; else exit 1; fi"
1718 &error("incomplete shell statement");
1721 # Operator '||' and '&&'
1722 elsif (s/^(\|\||&&)//) {
1723 $tmp = $1; # Save for perl5 (Dataloaded update_stack)
1724 &update_stack($tmp);
1726 # Unary operator '!'
1730 # Everything else is a test for a defined value
1731 elsif (s/^([\?%]?\w+)//) {
1734 if ($tmp =~ s/^\?//) {
1735 &push_val(($main'symwanted{$tmp})? 1 : 0);
1737 # Test for conditionally wanted
1738 elsif ($tmp =~ s/^%//) {
1739 &push_val(($main'condwanted{$tmp})? 1 : 0);
1741 # Default: test for definition (see op @define)
1744 $main'symwanted{$tmp} ||
1745 $main'cmaster{$tmp} ||
1746 $main'userdef{$tmp}) ? 1 : 0);
1749 # An error occured -- we did not recognize the expression
1751 s/^([^\s\(\)\{\|&!]+)//; # Skip until next meaningful char
1756 # Given an expression in a '@' command, returns a boolean which is
1757 # the result of the evaluation. Evaluate is collecting all the lines
1758 # in the expression into a single string, and then calls eval_expr to
1759 # really evaluate it.
1761 local($val); # Value returned
1762 local($expr) = ""; # Expression to be parsed
1764 while (s/\\$//) { # While end of line escaped
1766 $_ = <UNIT>; # Fetch next line
1768 &error("EOF in expression");
1774 while ($expr ne '') {
1775 $val = &eval_expr(*expr); # Expression will be modified
1776 # We return from eval_expr either when a closing parenthisis
1777 # is found, or when the expression has been fully analysed.
1778 &error("extra closing parenthesis ignored") if $expr ne '';
1783 # Given a line, we search for commands (lines starting with '@').
1784 # If there is no command in the line, then we return the boolean state.
1785 # Otherwise, the command is analysed and a new state is computed.
1786 # The returned value of interpret is 1 if the line is to be printed.
1787 sub main'interpret {
1789 local($status) = $state[$#state]; # Current status
1790 if (s|^\s*@\s*(\w+)\s*(.*)|$2|) {
1792 $cmd =~ y/A-Z/a-z/; # Canonicalize to lower case
1793 # The 'define' command
1794 if ($cmd eq 'define') {
1796 $userdef{$_}++ if $Keep[$status];
1800 elsif ($cmd eq 'if') {
1801 # We always evaluate, in order to find possible errors
1802 $value = &evaluate($_);
1803 if (!$Keep[$status]) {
1804 # We have to skip until next 'end'
1805 push(@state, $SKIP); # Record structure
1808 if ($value) { # True
1816 # The 'else' command
1817 elsif ($cmd eq 'else') {
1818 &error("expression after 'else' ignored") if /\S/;
1819 $state[$#state] = $SKIP if $state[$#state] == $IF;
1820 return 0 if $state[$#state] == $SKIP;
1821 if ($state[$#state] == $OUT) {
1822 &error("unexpected 'else'");
1825 $state[$#state] = $ELSE;
1828 # The 'elsif' command
1829 elsif ($cmd eq 'elsif') {
1830 # We always evaluate, in order to find possible errors
1831 $value = &evaluate($_);
1832 $state[$#state] = $SKIP if $state[$#state] == $IF;
1833 return 0 if $state[$#state] == $SKIP;
1834 if ($state[$#state] == $OUT) {
1835 &error("unexpected 'elsif'");
1838 if ($value) { # True
1839 $state[$#state] = $IF;
1842 $state[$#state] = $NOT;
1847 elsif ($cmd eq 'end') {
1848 &error("expression after 'end' ignored") if /\S/;
1850 &error("unexpected 'end'") if $#state < 0;
1855 &error("unknown command '$cmd'");
1865 if (! -f '.package') {
1868 -f '../../.package' ||
1869 -f '../../../.package' ||
1870 -f '../../../../.package'
1872 die "Run in top level directory only.\n";
1874 die "No .package file! Run packinit.\n";
1877 open(PACKAGE,'.package');
1881 if (($var,$val) = /^\s*(\w+)=(.*)/) {
1882 $val = "\"$val\"" unless $val =~ /^['"]/;
1883 eval "\$$var = $val;";
1890 # make MANIFEST and MANIFEST.new say the same thing
1891 if (! -f $NEWMANI) {
1893 open(IN,$MANI) || die "Can't open $MANI";
1894 open(OUT,">$NEWMANI") || die "Can't create $NEWMANI";
1897 # Everything until now was a header...
1899 open(OUT,">$NEWMANI") ||
1900 die "Can't recreate $NEWMANI";
1903 s/^\s*(\S+\s+)[0-9]*\s*(.*)/$1$2/;
1905 print OUT "\n" unless /\n$/; # If no description
1911 die "You need to make a $NEWMANI file, with names and descriptions.\n";
1916 # Perform ~name expansion ala ksh...
1917 # (banish csh from your vocabulary ;-)
1920 return $path unless $path =~ /^~/;
1921 $path =~ s:^~([^/]+):(getpwnam($1))[$[+7]:e; # ~name
1922 $path =~ s:^~:$ENV{'HOME'} || (getpwuid($<))[$[+7]:e; # ~
1926 # Set up profile components into %Profile, add any profile-supplied options
1927 # into @ARGV and return the command invocation name.
1929 local($profile) = &tilda_expand($ENV{'DIST'} || '~/.dist_profile');
1930 local($me) = $0; # Command name
1931 $me =~ s|.*/(.*)|$1|; # Keep only base name
1932 return $me unless -s $profile;
1933 local(*PROFILE); # Local file descriptor
1934 local($options) = ''; # Options we get back from profile
1935 unless (open(PROFILE, $profile)) {
1936 warn "$me: cannot open $profile: $!\n";
1942 next if /^\s*#/; # Skip comments
1943 next unless /^$me/o;
1944 if (s/^$me://o) { # progname: options
1946 $options .= $_; # Merge options if more than one line
1948 elsif (s/^$me-([^:]+)://o) { # progname-component: value
1951 s/^\s+//; # Trim leading and trailing spaces
1953 $Profile{$component} = $_;
1957 return unless $options;
1958 require 'shellwords.pl';
1960 eval '@opts = &shellwords($options)'; # Protect against mismatched quotes
1961 unshift(@ARGV, @opts);
1962 return $me; # Return our invocation name