#!/usr/bin/perl

%symtab = ();
%duptab = ();
$TAGSFILE = "tags";
$XREFFILE = "tags.xref";
%lineno = ();

while (<>) {
    s/\n$//;
    $line = $_;
    s/!.*//;
    $file = $ARGV; $lineno = $.;
    /\bEND +INTERFACE\b/i && &end_interface;
    /\bEND\b/i && next;
    /\bTYPE +(\w+)\b/i && &register_name($1);
    /\bSUBROUTINE +(\w+)\b/i && &register_proc($1);
    /\bMODULE +(\w+) *$/i && &register_name($1);
    /\bFUNCTION +(\w+)\b/i && &register_proc($1);
    /\bINTERFACE +(\w+)\b/i && &register_interface($1);
    /\bPARAMETER *:: *(\w+)\b/i && &register_name($1);
}
# dump tags file
open(TAGS, ">$TAGSFILE") || die $TAGSFILE;
foreach $name (sort keys %symtab) {
    print TAGS "$name\t$symtab{$name}\n";
}
close(TAGS);
if (%duptab > 0) {
    open(XREF, ">$XREFFILE") || die $XREFFILE;
    foreach $name (sort keys %duptab) {
        print XREF "$name\n";
        foreach $item (split("\n", $duptab{$name})) {
            print XREF "  $item\n";
        }
    }
    close(XREF);
}

exit 0;

sub canonify {
    local($name) = @_;
    $name =~ tr/a-z/A-Z/;
    return $name;
}

sub location {
    local($pattern) = substr($line, 0, 51);
    $pattern .= '$' if (length($line) <= 51);
    $location = "$file\t/^${pattern}/";
    $lineno{$location} = $lineno;
    $location;
}

sub register_name {
    local($name) = @_;
    &register_name_literal($name);
    local($xname) = $name;
    $xname =~ tr/a-z/A-Z/;
    &register_name_literal($xname);
    $xname =~ tr/A-Z/a-z/;
    &register_name_literal($xname);
}

sub register_name_literal {
    local($name) = @_;
    $location = &location;
    if (defined($symtab{$name})) {
        return if ($location eq $symtab{$name});
        if (defined($duptab{$name})) {
            @duplist = split("\n", $duptab{$name});
        } else {
            $loco = $symtab{$name};
            $lno = $lineno{$loco};
            $fnam = $loco;
            $fnam =~ s/\t.*//;
            $fnam =~ s/\W/_/g;
            $fnam = "__" . $fnam . "__" . $lno;
            $symtab{$fnam} = $loco;
            @duplist = ($fnam);
        }
        $fnam = $file;
        $fnam =~ s/\W/_/g;
        $fnam = "__" . $fnam . "__" . $lineno;
        $symtab{$fnam} = $location;
        push @duplist, $fnam;
        $symtab{$name} = "$XREFFILE\t/^$name/";
        $duptab{$name} = join("\n", @duplist);
    } else {
        $symtab{$name} = $location;
    }
}

sub register_proc {
    local($name) = @_;
    return if $interface;
    &register_name($name);
}

sub register_interface {
    local($name) = @_;
    $interface = $name;
    &register_name($name);
}

sub end_interface {
    $interface = undef;
}