#! /usr/local/bin/perl
##
## Copyright (c) 2000, 2001 University of Utah and the Flux Group.
## All rights reserved.
## 
## This file is part of the Knit component composition software.
## 
## Permission to use, copy, modify, distribute, and sell this software and
## its documentation is hereby granted without fee, provided that the above
## copyright notice and this permission/disclaimer notice is retained in all
## copies or modified versions, and that both notices appear in supporting
## documentation.  THE COPYRIGHT HOLDERS PROVIDE THIS SOFTWARE "AS IS" AND
## WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION,
## THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
## PURPOSE.  THE COPYRIGHT HOLDERS DISCLAIM ANY LIABILITY OF ANY KIND FOR
## ANY DAMAGES WHATSOEVER RESULTING FROM THE USE OF THIS SOFTWARE.
## 
## Users are requested, but not required, to send to csl-dist@cs.utah.edu any
## improvements that they make and grant Univ. of Utah redistribution rights.
##

$nm = "nm";

$name = "XXX";  # override with -n
@files=();

while ($ARGV[0] =~ /^-/) {
    $_ = shift;
    if (/^-n(.*)/) {
	$name = $1 ? $1 : shift;
    } else {
	die "Unrecognized switch: $_\n";
    }
}

while (@ARGV && $ARGV[0] ne "--") {
    $f = shift;
    &typeof($f);
}

if (@ARGV) {
    shift @ARGV;
}

while (@ARGV && $ARGV[0] ne "--") {
    $f = shift;
    &uses($f);
}

if (@ARGV) {
    shift @ARGV;
    @genbundle_args = @ARGV;
}

$IN  = \%IMPORTS;
$OUT = \%EXPORTS;
$USES = \%USES;

$IN   = &diff($IN,$OUT);        # undefined symbols
$USES = &diff($OUT,$USES);      # unused exports

@IN  = sort(keys %$IN);
@OUT = sort(keys %$OUT);
@USES = sort(keys %$USES);

    if (@genbundle_args) {
        system "knitGenBundles @genbundle_args $name -- @IN -- @OUT -- @USES -- @files";
    } else {
print "
unit $name = {
  imports[ in  : { ", join(",\n                   ", @IN), ",
                 },
         ];
  exports[ out : { ", join(",\n                   ", @OUT), ",
                 },
         ];
  depends{ exports + inits + finis  needs  imports; };
  files{
    ", join(",\n    ",@files), ",
  } with flags {};
}
";
    }

exit 0;

# This generates a list of possible imports from other files
# When you're chopping up a large program into units, it's useful
# to be able to restrict the exports of one unit to the possible 
# imports of the other units.
sub uses {
    local ($filename) = @_;
    local ($x,$file);
    open(FILE, "$nm -pa $filename |") || die "Can't find $filename\n";
    while (<FILE>) {
	@fields = split;

	if ($fields[0] =~ /[U]/) {
	    $USES{$fields[1]} = 1;
	} elsif ($fields[1] =~ /[C]/) {
	    $USES{$fields[2]} = 1;
	}
    }
    close FILE;
}

sub typeof {
    local ($filename) = @_;
    local ($x,$file);
    open(FILE, "$nm -pa $filename |") || die "Can't find $filename\n";
    while (<FILE>) {
	@fields = split;

	if ($fields[0] =~ /[U]/) {
	    $IMPORTS{$fields[1]} = 1;
	} elsif ($fields[1] =~ /[ABCDGIRSTW]/) {
	    $EXPORTS{$fields[2]} = 1;
	} elsif ($fields[1] eq 'a' && $fields[2] =~ /[a-zA-Z0-9_-]+.c/) {
            # gcc annotates .o files with the filename
	    $file = $fields[2];
        }
    }

#    # if we didn't find a filename, it's probably assembly language
#    $file = substr($filename,0,-1) . "S" unless defined $file;
#
#    if ($use_obj_filenames) { # vile hack!
#        $file = $filename;
#    }

    # We could pay attention to file annotations but, since they lack
    # directory info, it's (arguably) better to go with the name of
    # the .o file.  This has the merit of creating a unit description
    # which would work (since .o files are legal in the files section
    # of a unit description).
    $file = $filename;

    push(@files,'\"' . $file . '\"');

    close FILE;
}

sub diff {
    local ($X,$Y) = @_;
    local ($x,%r);
    foreach $x (keys %$X) {
	$r{$x} = 1 unless exists $$Y{$x};
    }
    return \%r;
}

sub intersect {
    local ($X,$Y) = @_;
    local ($x,%r);
    foreach $x (keys %$X) {
	$r{$x} = 1 if exists $$Y{$x};
    }
    return \%r;
}

sub zap {
    local ($X,$patt) = @_;
    local ($x,%r);
    foreach $x (keys %$X) {
	$r{$x} = 1 unless $x =~ /$patt/;
    }
    return \%r;
}

## End of file.
