autom4te.in

来自「LINUX下的源码工具,可自己分析,或者直接装在系统上作为应用」· IN 代码 · 共 1,233 行 · 第 1/3 页

## --------------------- ##


# $M4_MACRO
# trace_format_to_m4 ($FORMAT)
# ----------------------------
# Convert a trace $FORMAT into a M4 trace processing macro's body.
sub trace_format_to_m4 ($)
{
  my ($format) = @_;
  my $underscore = $_;
  my %escape = (# File name.
		'f' => '$1',
		# Line number.
		'l' => '$2',
		# Depth.
		'd' => '$3',
		# Name (also available as $0).
		'n' => '$4',
		# Escaped dollar.
		'$' => '$');

  my $res = '';
  $_ = $format;
  while ($_)
    {
      # $n -> $(n + 4)
      if (s/^\$(\d+)//)
	{
	  $res .= "\$" . ($1 + 4);
	}
      # $x, no separator given.
      elsif (s/^\$([fldn\$])//)
        {
	  $res .= $escape{$1};
	}
      # $.x or ${sep}x.
      elsif (s/^\$\{([^}]*)\}([@*%])//
	    || s/^\$(.?)([@*%])//)
	{
	  # $@, list of quoted effective arguments.
	  if ($2 eq '@')
	    {
	      $res .= ']at_at([' . ($1 ? $1 : ',') . '], $@)[';
	    }
	  # $*, list of unquoted effective arguments.
	  elsif ($2 eq '*')
	    {
	      $res .= ']at_star([' . ($1 ? $1 : ',') . '], $@)[';
	    }
	  # $%, list of flattened unquoted effective arguments.
	  elsif ($2 eq '%')
	    {
	      $res .= ']at_percent([' . ($1 ? $1 : ':') . '], $@)[';
	    }
	}
      elsif (/^(\$.)/)
        {
	  error "invalid escape: $1";
        }
      else
        {
	  s/^([^\$]+)//;
	  $res .= $1;
        }
    }

  $_ = $underscore;
  return '[[' . $res . ']]';
}


# handle_traces($REQ, $OUTPUT, %TRACE)
# ------------------------------------
# We use M4 itself to process the traces.  But to avoid name clashes when
# processing the traces, the builtins are disabled, and moved into `at_'.
# Actually, all the low level processing macros are in `at_' (and `_at_').
# To avoid clashes between user macros and `at_' macros, the macros which
# implement tracing are in `AT_'.
#
# Having $REQ is needed to neutralize the macros which have been traced,
# but are not wanted now.
sub handle_traces ($$%)
{
  my ($req, $output, %trace) = @_;

  verbose "formatting traces for `$output': ", join (', ', sort keys %trace);

  # Processing the traces.
  my $trace_m4 = new Autom4te::XFile (">$tmp/traces.m4");

  $_ = <<'EOF';
  divert(-1)
  changequote([, ])
  # _at_MODE(SEPARATOR, ELT1, ELT2...)
  # ----------------------------------
  # List the elements, separating then with SEPARATOR.
  # MODE can be:
  #  `at'       -- the elements are enclosed in brackets.
  #  `star'     -- the elements are listed as are.
  #  `percent'  -- the elements are `flattened': spaces are singled out,
  #                and no new line remains.
  define([_at_at],
  [at_ifelse([$#], [1], [],
             [$#], [2], [[[$2]]],
             [[[$2]][$1]$0([$1], at_shift(at_shift($@)))])])

  define([_at_percent],
  [at_ifelse([$#], [1], [],
             [$#], [2], [at_flatten([$2])],
             [at_flatten([$2])[$1]$0([$1], at_shift(at_shift($@)))])])

  define([_at_star],
  [at_ifelse([$#], [1], [],
             [$#], [2], [[$2]],
             [[$2][$1]$0([$1], at_shift(at_shift($@)))])])

  # FLATTEN quotes its result.
  # Note that the second pattern is `newline, tab or space'.  Don't lose
  # the tab!
  define([at_flatten],
  [at_patsubst(at_patsubst(at_patsubst(at_patsubst([[[[$1]]]], [\\\n]),
                                       [[\n\t ]+], [ ]),
                           [ *\(.\)$], [\1]),
	       [^ *\(.*\)], [[\1]])])

  define([at_args],    [at_shift(at_shift(at_shift(at_shift(at_shift($@)))))])
  define([at_at],      [_$0([$1], at_args($@))])
  define([at_percent], [_$0([$1], at_args($@))])
  define([at_star],    [_$0([$1], at_args($@))])

EOF
  s/^  //mg;s/\\t/\t/mg;s/\\n/\n/mg;
  print $trace_m4 $_;

  # If you trace `define', then on `define([m4_exit], defn([m4exit])' you
  # will produce
  #
  #    AT_define([m4sugar.m4], [115], [1], [define], [m4_exit], <m4exit>)
  #
  # Since `<m4exit>' is not quoted, the outer m4, when processing
  # `trace.m4' will exit prematurely.  Hence, move all the builtins to
  # the `at_' name space.

  print $trace_m4 "# Copy the builtins.\n";
  map { print $trace_m4 "define([at_$_], defn([$_]))\n" } @m4_builtin;
  print $trace_m4 "\n";

  print $trace_m4 "# Disable them.\n";
  map { print $trace_m4 "at_undefine([$_])\n" } @m4_builtin;
  print $trace_m4 "\n";


  # Neutralize traces: we don't want traces of cached requests (%REQUEST).
  print $trace_m4
   "## -------------------------------------- ##\n",
   "## By default neutralize all the traces.  ##\n",
   "## -------------------------------------- ##\n",
   "\n";
  print $trace_m4 "at_define([AT_$_], [at_dnl])\n"
    foreach (sort keys %{$req->macro});
  print $trace_m4 "\n";

  # Implement traces for current requests (%TRACE).
  print $trace_m4
    "## ------------------------- ##\n",
    "## Trace processing macros.  ##\n",
    "## ------------------------- ##\n",
    "\n";
  foreach (sort keys %trace)
    {
      # Trace request can be embed \n.
      (my $comment = "Trace $_:$trace{$_}") =~ s/^/\# /;
      print $trace_m4 "$comment\n";
      print $trace_m4 "at_define([AT_$_],\n";
      print $trace_m4 trace_format_to_m4 ($trace{$_}) . ")\n\n";
    }
  print $trace_m4 "\n";

  # Reenable output.
  print $trace_m4 "at_divert(0)at_dnl\n";

  # Transform the traces from m4 into an m4 input file.
  # Typically, transform:
  #
  # | m4trace:configure.ac:3: -1- AC_SUBST([exec_prefix], [NONE])
  #
  # into
  #
  # | AT_AC_SUBST([configure.ac], [3], [1], [AC_SUBST], [exec_prefix], [NONE])
  #
  # Pay attention that the file name might include colons, if under DOS
  # for instance, so we don't use `[^:]+'.
  my $traces = new Autom4te::XFile ($tcache . $req->id);
  while ($_ = $traces->getline)
    {
      # Trace with arguments, as the example above.  We don't try
      # to match the trailing parenthesis as it might be on a
      # separate line.
      s{^m4trace:(.+):(\d+): -(\d+)- ([^(]+)\((.*)$}
       {AT_$4([$1], [$2], [$3], [$4], $5};
      # Traces without arguments, always on a single line.
      s{^m4trace:(.+):(\d+): -(\d+)- ([^)]*)\n$}
       {AT_$4([$1], [$2], [$3], [$4])\n};
      print $trace_m4 "$_";
    }
  $trace_m4->close;

  my $in = new Autom4te::XFile ("$m4 $tmp/traces.m4 |");
  my $out = new Autom4te::XFile (">$output");

  # This is dubious: should we really transform the quadrigraphs in
  # traces?  It might break balanced [ ] etc. in the output.  The
  # consensus seeems to be that traces are more useful this way.
  while ($_ = $in->getline)
    {
      # It makes no sense to try to transform __oline__.
      s/\@<:\@/[/g;
      s/\@:>\@/]/g;
      s/\@\$\|\@/\$/g;
      s/\@%:\@/#/g;
      s/\@&t\@//g;
      print $out $_;
    }
}


# $BOOL
# up_to_date ($REQ)
# -----------------
# Are the cache files of $REQ up to date?
# $REQ is `valid' if it corresponds to the request and exists, which
# does not mean it is up to date.  It is up to date if, in addition,
# its files are younger than its dependencies.
sub up_to_date ($)
{
  my ($req) = @_;

  return 0
    if ! $req->valid;

  my $tfile = $tcache . $req->id;
  my $ofile = $ocache . $req->id;

  # We can't answer properly if the traces are not computed since we
  # need to know what other files were included.  Actually, if any of
  # the cache files is missing, we are not up to date.
  return 0
    if ! -f $tfile || ! -f $ofile;

  # The youngest of the cache files must be older than the oldest of
  # the dependencies.
  my $tmtime = mtime ($tfile);
  my $omtime = mtime ($ofile);
  my ($file, $mtime) = ($tmtime < $omtime
			? ($ofile, $omtime) : ($tfile, $tmtime));

  # We depend at least upon the arguments.
  my @dep = @ARGV;

  # Files may include others.  We can use traces since we just checked
  # if they are available.
  handle_traces ($req, "$tmp/dependencies",
		 ('include'    => '$1',
		  'm4_include' => '$1'));
  my $deps = new Autom4te::XFile ("$tmp/dependencies");
  while ($_ = $deps->getline)
    {
      chomp;
      my $file = find_file ("$_?", @include);
      # If a file which used to be included is no longer there, then
      # don't say it's missing (it might no longer be included).  But
      # of course, that cause the output to be outdated (as if the
      # time stamp of that missing file was newer).
      return 0
	if ! $file;
      push @dep, $file;
    }

  # If $FILE is younger than one of its dependencies, it is outdated.
  return up_to_date_p ($file, @dep);
}


## ---------- ##
## Freezing.  ##
## ---------- ##

# freeze ($OUTPUT)
# ----------------
sub freeze ($)
{
  my ($output) = @_;

  # When processing the file with diversion disabled, there must be no
  # output but comments and empty lines.
  my $result = xqx ("$m4"
		    . ' --fatal-warning'
		    . join (' --include=', '', @include)
		    . ' --define=divert'
		    . " " . files_to_options (@ARGV)
		    . ' </dev/null');
  $result =~ s/#.*\n//g;
  $result =~ s/^\n//mg;

  error "freezing produced output:\n$result"
    if $result;

  # If freezing produces output, something went wrong: a bad `divert',
  # or an improper paren etc.
  xsystem ("$m4"
	   . ' --fatal-warning'
	   . join (' --include=', '', @include)
	   . " --freeze-state=$output"
	   . " " . files_to_options (@ARGV)
	   . ' </dev/null');
}

## -------------- ##
## Main program.  ##
## -------------- ##

mktmpdir ('am4t');
load_configuration ($ENV{'AUTOM4TE_CFG'} || "$datadir/autom4te.cfg");
load_configuration ("$ENV{'HOME'}/.autom4te.cfg")
  if -f "$ENV{'HOME'}/.autom4te.cfg";
load_configuration (".autom4te.cfg")
  if -f ".autom4te.cfg";
parse_args;

# Freezing does not involve the cache.
if ($freeze)
  {
    freeze ($output);
    exit 0;
  }

# We need our cache directory.
if (! -d "$cache")
  {
    mkdir "$cache", 0755
      or error "cannot create $cache: $!";
  }

# Read the cache index if available and older than autom4te itself.
# If autom4te is younger, then some structures such as Request, might
# have changed, which would corrupt its processing.
Request->load ($icache)
  if -f $icache && mtime ($icache) > mtime ($0);

# Add the new trace requests.
my $req = Request->request ('input' => \@ARGV,
			    'path'  => \@include,
			    'macro' => [keys %trace, @preselect]);

# If $REQ's cache files are not up to date, or simply if the user
# discarded them (-f), declare it invalid.
$req->valid (0)
  if $force || ! up_to_date ($req);

# We now know whether we can trust the Request object.  Say it.
verbose "$me: the trace request object is:\n" . $req->marshall;

# We need to run M4 if (i) the users wants it (--force), (ii) $REQ is
# invalid.
handle_m4 ($req, keys %{$req->macro})
  if $force || ! $req->valid;

# Now output...
if (%trace)
  {
    # Always produce traces, since even if the output is young enough,
    # there is no guarantee that the traces use the same *format*
    # (e.g., `-t FOO:foo' and `-t FOO:bar' are both using the same M4
    # traces, hence the M4 traces cache is usable, but its formatting
    # will yield different results).
    handle_traces ($req, $output, %trace);
  }
else
  {
    # Actual M4 expansion, only if $output is too old. STDOUT is
    # pretty old.
    handle_output ($req, $output)
      if mtime ($output) < mtime ($ocache . $req->id);
  }

# If all went fine, the cache is valid.
$req->valid (1)
  if $exit_status == 0;

Request->save ($icache);

exit $exit_status;

### Setup "GNU" style for perl-mode and cperl-mode.
## Local Variables:
## perl-indent-level: 2
## perl-continued-statement-offset: 2
## perl-continued-brace-offset: 0
## perl-brace-offset: 0
## perl-brace-imaginary-offset: 0
## perl-label-offset: -2
## cperl-indent-level: 2
## cperl-brace-offset: 0
## cperl-continued-brace-offset: 0
## cperl-label-offset: -2
## cperl-extra-newline-before-brace: t
## cperl-merge-trailing-else: nil
## cperl-continued-statement-offset: 2
## End: