#!/usr/bin/perl

use strict;
use warnings;

my $seenGlobalDups = 0;
my $seenUnitDups   = undef;

my $dumpAllSymbols = 0; # dump ALL found symbols (debugging only)

my %gloc = (); # [global] key=symbol, value=location (or empty string)
my %lloc = (); # [local]  key=symbol, value=location (or empty string)
my %dloc = (); # key=symbol, value=location in .sym file where first defined

sub acceptDupSym($);
sub acceptDupSym($) {
  # return true for all symbols that shall be accepted if duplicated
  my ($sym) = @_;
  # return 0 if $sym =~ /aw_never_called_main/o; # @@@ check whether AW_HEADER_MAIN is necessary
  if ($sym =~ /^(ARB_main|aw_never_called_main)\(/o) {
    return 1; # special ARB function
  }
  if ($sym eq 'aisc_main') {
    return 1; # special ARB variable in generated code (exists once in PTSERVER and in NAMESERVER)
  }
  if ($sym =~ /^(_init|_fini)$/o) { # formerly also accepted __bss_start _edata and _end
    return 1; # shared lib entry/exit points
  }
  if ($sym =~ /^__odr_asan\./o) { # ignore ASAN prefixes
    return acceptDupSym($');
  }
  return 0;
}

sub addSym($$$$) {
  my ($sym, $sloc, $symfile, $lineno) = @_;

  my $haveLoc = $lloc{$sym};
  my $haveDLoc = $dloc{$sym};
  if (not defined $haveLoc) {
    $lloc{$sym} = $sloc; # first definition
  }
  elsif ($haveLoc eq $sloc) { die "redefined symbol '$sym' with same location"; }
  else {
    die "had empty first definition (sym=$sym; sloc=$sloc)\n" if $haveLoc eq '';
    die "empty redefinition (sym=$sym)\n" if $sloc eq '';

    my $dloc = $symfile.':'.$lineno;
    print "$haveLoc: Warning: first definition of $sym\n";
    print "$dloc: Error: duplicated definition of $sym (in same unit). Bug?\n";
    $seenUnitDups++;
  }

  if (not defined $haveDLoc) {
    $dloc{$sym} = $symfile.':'.$lineno;
  }
}

sub scanSymdef($$$) {
  my ($line, $symfile, $lineno) = @_;
  if ($line ne '') {
    # format of symlist is documented at ./make_symlist.sh@SYMLIST_FORMAT

    my @splitted = split /;/,$line;
    my $splitted = scalar(@splitted);

    die "expected to see 3 or 4 semicolon-separted parts (got: $splitted)" if $splitted<3 or $splitted>4;

    my ($symScope, $symType, $protoOrName, $sloc)
      = ( $splitted[0], $splitted[1], $splitted[2], $splitted[3] );
    if (not defined $sloc) { $sloc = ''; }

    if ($symScope eq 'def') {
      addSym($protoOrName, $sloc, $symfile, $lineno);
    }
    elsif ($symScope eq 'ref') {
      # ignore references
    }
    else {
        die "cannot parse line '$line'\n";
    }
  }
}

sub nonEmpty($$) {
  my ($locMaybeEmpty,$fakeLoc) = @_;
  return $locMaybeEmpty eq '' ? $fakeLoc : $locMaybeEmpty;
}

sub dumpSymbolsOfThisUnit($) {
  my ($fallback_loc) = @_;

  my @sortedSyms = sort {
    die if not defined $a;
    die if not defined $b;

    my $aloc = $lloc{$a};
    my $bloc = $lloc{$b};

    die if not defined $aloc;
    die if not defined $bloc;

    if (($aloc ne '') and ($bloc ne '')) {
      my @aloc = split /:/o, $aloc;
      my @bloc = split /:/o, $bloc;

      if (scalar(@aloc)==3 and scalar(@bloc)==3) {
        my $cmp = $aloc[0] cmp $bloc[0]; # compare filenames
        if ($cmp == 0) {
          if (($aloc[1] eq '') or ($bloc[1] eq '')) {
            my $d1 = 'aloc[1]='.$aloc[1].' bloc[1]='.$bloc[1];
            my $d2 = "a='$a' b='$b'";
            my $d3 = "aloc='$aloc' bloc='$bloc'";
            die "unexpected value parsed from locations: $d1 $d2 $d3\n ";
          }
          $cmp = $aloc[1] <=> $bloc[1]; # compare linenumbers
          if ($cmp==0) {
            $cmp = $a cmp $b;
            die if $cmp eq 0;
          }
        }
        $cmp;
      }
      else { die "broken locations detected\n"; }
    }
    else { $a cmp $b; }
  } keys %lloc;

  foreach my $sym (@sortedSyms) {
    my $loc = $lloc{$sym};
    print nonEmpty($loc, $fallback_loc).": Note: definition of symbol '$sym'\n";
  }
}

my %warned = (); # key=symbol, value=1 if already warned about duplicate

sub addFileSymbols($) {
  # called after symfile has been completely scanned

  my ($symfile) = @_;
  my $fallback_loc = $symfile.':1';

  foreach my $sym (keys %lloc) {
    my $loc = $lloc{$sym}; # is empty for _init and _fini.
    my $haveGlobal = $gloc{$sym};
    if (defined $haveGlobal) {
      if (not acceptDupSym($sym)) {
        my $firstDefAt = $dloc{$sym};
        my $duplicated = 'another';
        if (not exists $warned{$sym}) {
          print nonEmpty($haveGlobal,$firstDefAt).": Warning: first occurrence of $sym\n";
          $warned{$sym} = 1;
          $duplicated = 'duplicated';
        }
        print nonEmpty($loc,$fallback_loc).": Warning: $duplicated occurrence of $sym\n";
        $seenGlobalDups++;

        if ($loc ne '') {
          $gloc{$sym} = $loc;
        }
      }
    }
    else {
      $gloc{$sym} = $loc;
    }
  }

  if ($dumpAllSymbols) {
    dumpSymbolsOfThisUnit($fallback_loc);
  }

  # reset local symbol tracking:
  %lloc = ();
}

sub scanSymfile($) {
  my ($symfile) = @_;
  open(IN,'<'.$symfile) || die "failed to open '$symfile' (Reason: $!)";

  my $lineno = 0;
  eval {
    my $line;
    while (defined($line=<IN>)) {
      chomp($line);
      $lineno++;
      scanSymdef($line, $symfile, $lineno);
    }
  };
  if ($@) {
    die "$symfile:$lineno: $@";
  }
  close(IN);
}

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

sub main() {
  my $args = scalar(@ARGV);
  if ($args<1) {
    die "Usage: dupsymwarn.pl make_symlist-output [make_symlist-output]+\n".
      "Collects and warns about duplicated global symbols\n";
  }

  foreach my $symfile (@ARGV) { # one symfile for each unit
    $seenUnitDups = 0;

    scanSymfile($symfile);
    addFileSymbols($symfile);

    if ($seenUnitDups>0) {
      print "Please note: detected $seenUnitDups duplicate symbols in unit ($symfile)\n";
      print "             This may occur e.g. after renaming a source file.\n";
      print "             In that case try to clean that UNIT using 'make UNIT/UNIT.clean'\n";
    }
  }

  if ($seenGlobalDups>0) {
    my $diffDups = scalar(keys %warned);
    print "Encountered $seenGlobalDups duplicated global symbols in arb-codebase ($diffDups different)\n";
    print "Notes:\n";
    print " * this is checked in TESTED modules/libraries only.\n";
    print " * duplicated symbols are unwanted => please fix them!\n";
  }
}
main();