nasm/tools/mkdep.pl

#!/usr/bin/perl
## --------------------------------------------------------------------------
##
##   Copyright 1996-2024 The NASM Authors - All Rights Reserved
##   See the file AUTHORS included with the NASM distribution for
##   the specific copyright holders.
##
##   Redistribution and use in source and binary forms, with or without
##   modification, are permitted provided that the following
##   conditions are met:
##
##   * Redistributions of source code must retain the above copyright
##     notice, this list of conditions and the following disclaimer.
##   * Redistributions in binary form must reproduce the above
##     copyright notice, this list of conditions and the following
##     disclaimer in the documentation and/or other materials provided
##     with the distribution.
##
##     THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND
##     CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
##     INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
##     MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
##     DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR
##     CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
##     SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
##     NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
##     LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
##     HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
##     CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
##     OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE,
##     EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
##
## --------------------------------------------------------------------------

#
# Script to create Makefile-style dependencies.
#
# Usage:
#   perl mkdep.pl [-i][-e][-m makefile]...[-M makefile... --] dir...
#

use strict;
use integer;

use File::Spec;
use File::Basename;
use File::Copy;
use File::Temp;
use Fcntl;

my $barrier =
    "#-- Everything below is generated by mkdep.pl - do not edit --#\n";

# This converts from filenames to full pathnames for our dependencies
# These are arrays of [full path, Makefile path]
my %dep_path = ();

# List of files that cannot be found; these *must* be excluded
my @must_exclude = ();

#
# Variables derived from the command line
#
my %deps;
my %excludes;
my @files;
my @mkfiles;
my $mkmode = 0;
my @searchdirs = (File::Spec->curdir());
my %searchdirs = (File::Spec->curdir() => 1);
my $force_inline = 0;
my $externalize = 0;
my $debug = 0;

#
# Scan files for dependencies
# $path is the full filesystem path, $file Makefile name
#
sub scandeps {
    my($path, $file) = @_;
    my $line;
    my %xdeps;
    my %mdeps;

    print STDERR "mkdep: scanning file: $path\n" if ( $debug );

    my $fh;
    if (!open($fh, '<', $path)) {
	print STDERR "    -> missing, assume generated\n" if ( $debug );
	return;
    }

    while ( defined($line = <$fh>) ) {
	chomp $line;
	$line =~ s:/\*.*\*/::g;
	$line =~ s://.*$::;
	if ( $line =~ /^\s*\#\s*include\s+\"(.*)\"\s*$/ ) {
	    my $nf = $1;
	    my $dp = $dep_path{$nf};
	    if (!defined($dp)) {
		push(@must_exclude, $nf);
		print STDERR "    -> $nf [missing]\n" if ( $debug );
		next;
	    }
	    my $dn = $dp->[1];
	    $mdeps{$dn}++;
	    $xdeps{$dn} = $dp unless ( defined($deps{$dn}) );
	    printf STDERR "    -> %s (%s)\n", $nf, $dn if ( $debug );
	}
    }
    close($fh);
    $deps{$file} = [keys(%mdeps)];

    foreach my $xf ( keys(%xdeps) ) {
	scandeps(@{$xdeps{$xf}});
    }
}

# %deps contains direct dependencies.  This subroutine resolves
# indirect dependencies that result.
sub _alldeps($$$) {
    my($file, $level, $adeps) = @_;

    return if ($adeps->{$file});

    printf STDERR " %s-> %s\n", ('   ' x $level), $file;
    $adeps->{$file}++;

    foreach my $dep ( @{$deps{$file}} ) {
	_alldeps($dep, $level+1, $adeps);
    }
}

sub alldeps($) {
    my($file) = @_;

    my %adeps;
    _alldeps($file, 1, \%adeps);
    return sort(keys(%adeps));
}

# This converts a filename from host syntax to target syntax
# This almost certainly works only on relative filenames...
sub convert_file($$) {
    my($file,$sep) = @_;

    if ($file eq '' || $file eq File::Spec->curdir() ||
	$file eq File::Spec->rootdir()) {
	return undef;
    }

    my @fspec = (basename($file));
    while ( ($file = dirname($file)) ne File::Spec->curdir() &&
	    $file ne File::Spec->rootdir() ) {
	unshift(@fspec, basename($file));
    }

    if ( $sep eq '' ) {
	# This means kill path completely.  Used with Makes who do
	# path searches, but doesn't handle output files in subdirectories,
	# like OpenWatcom WMAKE.
	return $fspec[scalar(@fspec)-1];
    } else {
	return join($sep, @fspec);
    }
}

#
# Insert dependencies into a Makefile
#
sub insert_deps($) {
    my($file) = @_;

    open(my $in, '<', $file)
	or die "$0: Cannot open input: $file\n";

    my ($line, $parm, $val);
    my $obj = '.o';		# Defaults
    my $sep = '/';
    my $cont = "\\";
    my $include_command = undef;
    my $selfrule = 0;
    my $maxline = 78;		# Seems like a reasonable default
    my %exclude = ();		# Don't exclude anything
    my @genhdrs = ();
    my $external = undef;
    my $raw_output = 0;
    my @outfile = ();
    my $is_external = 0;

    while ( defined($line = <$in>) ) {
	if ( $line =~ /^([^\s\#\$\:]+\.h):/ ) {
	    # Note: we trust the first Makefile given best
	    my $fpath = $1;
	    my $fbase = basename($fpath);
	    if (!defined($dep_path{$fbase})) {
		$dep_path{$fbase} = [$fpath, $fpath];
		print STDERR "Makefile: $fbase -> $fpath\n";
	    }
	} elsif ( $line =~ /^\s*\#\s*@([a-z0-9-]+):\s*\"([^\"]*)\"/ ) {
	    $parm = $1;  $val = $2;
	    if ( $parm eq 'object-ending' ) {
		$obj = $val;
	    } elsif ( $parm eq 'path-separator' ) {
		$sep = $val;
	    } elsif ( $parm eq 'line-width' ) {
		$maxline = $val+0;
	    } elsif ( $parm eq 'continuation' ) {
		$cont = $val;
	    } elsif ( $parm eq 'exclude' ) {
		$excludes{$val}++;
	    } elsif ( $parm eq 'include-command' ) {
		$include_command = $val;
	    } elsif ( $parm eq 'external' ) {
		# Keep dependencies in an external file
		$external = $val;
	    } elsif ( $parm eq 'selfrule' ) {
		$selfrule = !!$val;
	    }
	} elsif ( $line =~ /^(\s*\#?\s*EXTERNAL_DEPENDENCIES\s*=\s*)([01])\s*$/ ) {
	    # If this line is not present, we cannot externalize
	    $is_external = $externalize ? 1 : $force_inline ? 0 : $2+0;
	    $line = $1.$is_external."\n";
	} elsif ( $line eq $barrier ) {
	    last;		# Stop reading at barrier line
	}

	push @outfile, $line;
    }
    close($in);

    $is_external = $is_external && defined($external);
    if ( !$is_external ) {
	undef $external;
	$selfrule = 0;
    }

    my $out;
    my $outpath;
    if ( !$is_external || $externalize ) {
	$out = File::Temp->new(DIR => dirname($outpath = $file));
	print $out @outfile;
    } else {
	$out = File::Temp->new(DIR => dirname($outpath = $external));
    }

    print $out $barrier;

    if ( $externalize ) {
	# Just strip internal file dependency information
	if (defined($include_command)) {
	    print $out "$include_command $external\n";
	}
	unlink($external);
    } else {
	my $e;

	foreach my $dfile ($external, sort(keys(%deps)) ) {
	    my $ofile;
	    my @deps;

	    next unless (defined($dfile));

	    if ( $selfrule && $dfile eq $external ) {
		$ofile = convert_file($dfile, $sep).':';
		@deps = sort(keys(%deps));
	    } elsif ( $dfile =~ /^(.*)\.[Cc]$/ ) {
		$ofile = convert_file($1, $sep).$obj.':';
		print STDERR "mkdep: dependencies for: $dfile\n";
		@deps = alldeps($dfile);
	    }

	    if (defined($ofile)) {
		my $len = length($ofile);
		print $out $ofile;
		foreach my $dep (@deps) {
		    unless ($excludes{$dep}) {
			my $str = convert_file($dep, $sep);
			my $sl = length($str)+1;
			if ( $len+$sl > $maxline-2 ) {
			    print $out ' ', $cont, "\n ", $str;
			    $len = $sl;
			} else {
			    print $out ' ', $str;
			    $len += $sl;
			}
		    }
		}
		print $out "\n";
	    }
	}
    }

    close($out);
    move($out->filename, $outpath);
}

#
# Main program
#

while ( defined(my $arg = shift(@ARGV)) ) {
    if ( $arg eq '-m' ) {
	$arg = shift(@ARGV);
	push(@mkfiles, $arg);
    } elsif ( $arg eq '-s' ) {
	$arg = shift(@ARGV);
	push(@searchdirs, $arg);
    } elsif ( $arg eq '-i' ) {
	$force_inline = 1;
    } elsif ( $arg eq '-e' ) {
	$externalize = 1;
    } elsif ( $arg eq '-d' ) {
	$debug++;
    } elsif ( $arg eq '-M' ) {
	$mkmode = 1;		# Further filenames are output Makefile names
    } elsif ( $arg eq '--' && $mkmode ) {
	$mkmode = 0;
    } elsif ( $arg =~ /^-/ ) {
	die "Unknown option: $arg\n";
    } else {
	if ( $mkmode ) {
	    push(@mkfiles, $arg);
	} else {
	    push(@files, $arg);
	}
    }
}

sub mycatdir($$) {
    my($a,$b) = @_;
    return $b if ($a eq File::Spec->curdir());
    return $a if ($b eq File::Spec->curdir());
    return File::Spec->catdir($a,$b);
}

sub mycatfile($$) {
    my($d,$f) = @_;
    return $f if ($d eq File::Spec->curdir());
    return File::Spec->catfile($d,$f);
}

my @cfiles = ();

my $err = 0;
my %scanned;

foreach my $fdir ( @files ) {
    my $found = 0;

    foreach my $sdir ( @searchdirs ) {
	my $dir = mycatdir($sdir, $fdir);

	if ($scanned{$dir}) {
	    # Have already been here
	    $found = 1;
	    next;
	}

	print STDERR "mkdep: scanning directory $dir\n" if ( $debug );

	opendir(DIR, $dir) or next;
	$scanned{$dir}++;
	$found++;

	while ( my $file = readdir(DIR) ) {
	    # $fdir is correct here, because we expect VPATH to do
	    # its job, and the output filename depends on that, not
	    # on the full source dir path.
	    my $path = mycatfile($fdir, $file);
	    my $fullpath = mycatfile($dir, $file);
	    if ( $file =~ /\.[Cc]$/ ) {
		push(@cfiles, [$fullpath, $path]);
	    } elsif ( $file =~ /\.[Hh]$/ ) {
		print STDERR "mkdep: filesystem: $file -> $path\n" if ( $debug );
		if (defined($dep_path{$file})) {
		    print STDERR "mkdep: warning: more than one instance of filename $file!\n";
		}
		$dep_path{$file} = [$fullpath, $path];
		$dep_path{$path} = [$fullpath, $path];
	    }
	}
	closedir(DIR);
    }

    if (!$found) {
	print STDERR "$0: cannot find directory: $fdir\n";
	$err++;
    }
}

exit(1) if ($err);

foreach my $cfile ( @cfiles ) {
    scandeps(@$cfile);
}

foreach my $mkfile ( @mkfiles ) {
    insert_deps($mkfile);
}