#!/usr/bin/perl

# Copyright 2012-2022, BlueFANG 

use strict;
use warnings;
use Carp;
use feature 'say';
use Getopt::Long;
use Pod::Usage;
use Data::Dumper;
use Cwd;

my $man = 0;
my $help = 0;
my $initem = '';
my @hex_addresses = ();
my $verbose = '';
my $lookup_const = undef;
my @consts_of_interest = ();
my @values_of_interest = ();

#Getopt::Long::Configure ("bundling"); # to allow -abc to set a, b, and c

GetOptions ("help|?" => \$help, 
            man => \$man,
            verbose => \$verbose,
            "regaddr=s" => sub {
                if ($verbose) {
                    print "Pushing name $_[1]\n";
                }
                push @hex_addresses, hex $_[1];
            },
            "lookup=s" => sub {
                if ($verbose) {
                    print "Pushing const name $_[1]\n";
                }
                push @values_of_interest, ($_[1] =~ m/0x\d+/ ? hex $_[1] : $_[1]);
            },
            "const=s" => sub {
                if ($verbose) {
                    print "Pushing const value $_[1]\n";
                }
                push @consts_of_interest, ($_[1] =~ m/0x\d+/ ? hex $_[1] : $_[1]);
            },
    ) or pod2usage(2);

pod2usage(-exitval => 0, -verbose => 1) if $help;
pod2usage(-exitval => 0, -verbose => 2) if $man;

my $input_db = cwd."/scripts/perl/symdb.lst";

if ($ARGV[0]) {
    $input_db = $ARGV[0];
}

open FILE, $input_db or die "Cannot open input file $ARGV[0]\n";

my @offset_names = qw(EM_BLE_TX_BUFFER_DATA_OFFSET EM_BLE_RX_DESC_OFFSET 
    EM_BLE_RX_BUFFER_OFFSET EM_BLE_WPV_OFFSET EM_BLE_RAL_OFFSET 
    EM_BLE_WPB_OFFSET EM_BLE_TX_DESC_OFFSET EM_BLE_CS_OFFSET EM_BLE_TX_BUFFER_CNTL_OFFSET);

# EM_BLE_TX_AUDIO_BUFFER_OFFSET
# EM_BLE_RX_AUDIO_BUFFER_OFFSET --- there is no audio configured

my %const_hash = ();
my %value_lookup = ();

while (<FILE>) {

    my $inline = $_;

    if ( $inline =~ m/^(.+)=(\d+)\{([^{}]*)\}\{([^{}]*)\}$/ ) { # 

	my $name = $1;
        my $value = $2;
        my $origin = $4;
        my $location = $3;

        $const_hash{$name} = {
            value => $value,
            origin => $origin,
            location => $location
        };

        if ( !(exists $value_lookup{$value}) ) {
            $value_lookup{$value} = ["$name\{$location\}"];
        } else {
            push @{$value_lookup{$value}}, "$name\{$location\}";
        }
    }
}

my %area_period = (
    EM_BLE_CS_OFFSET => $const_hash{REG_BLE_EM_CS_SIZE},
    EM_BLE_RAL_OFFSET => $const_hash{REG_BLE_EM_RAL_SIZE},
    EM_BLE_WPV_OFFSET => $const_hash{REG_BLE_EM_WPV_SIZE},
    EM_BLE_WPB_OFFSET => $const_hash{REG_BLE_EM_WPB_SIZE},
#    EM_BLE_TX_AUDIO_BUFFER_OFFSET => $const_hash{REG_BLE_EM_TX_AUDIO_BUFFER_SIZE},
#    EM_BLE_RX_AUDIO_BUFFER_OFFSET => $const_hash{REG_BLE_EM_RX_AUDIO_BUFFER_SIZE},
    EM_BLE_TX_DESC_OFFSET => $const_hash{REG_BLE_EM_TX_DESC_SIZE},
    EM_BLE_RX_DESC_OFFSET => $const_hash{REG_BLE_EM_RX_DESC_SIZE},
    EM_BLE_RX_BUFFER_OFFSET => $const_hash{REG_BLE_EM_RX_BUFFER_SIZE},
    );

my %offset_subhash = %const_hash{@offset_names};
my %value_subhash;

for my $key (keys %offset_subhash) {
    $value_subhash{$offset_subhash{$key}->{value} + $const_hash{REG_COMMON_EM_ET_BASE_ADDR}->{value}} = $key;
}

$value_subhash{$const_hash{REG_BLECORE_BASE_ADDR}->{value}}="...";

my @offset_values = sort numerically keys %value_subhash;

sub fit_value($) {
    my $value = shift;
    my $lower = '';
    
    foreach my $i (0..$#offset_values) {
        if ( $lower and $offset_values[$i] > $value ) {
            return $lower;
        } elsif ( $offset_values[$i] <= $value ) {
            $lower = $value_subhash{$offset_values[$i]};
        } else {
            return undef;
        }
    }

    return undef;
}

sub numerically {
    $a<=>$b;
}

my %reg_addresses = ();
my %reg_names = ();

for my $key (keys %const_hash) {
    if ($key =~ m/BLE_(.*)_ADDR/) {
        $reg_addresses{$key} = $const_hash{$key}->{value};
        $reg_names{$const_hash{$key}->{value}} = $1;
    }
}

# output register names

for ( my $addr = 0; $addr < scalar @hex_addresses; $addr++ ) {

    my $group;
    my $reduced_addr;
    my $reg_index;
    my $base;
    my $reg_name;
    my $reg_abs;
    
    $group = fit_value($hex_addresses[$addr]);

    if ( $group eq "..." ) {
        $base = $const_hash{REG_BLECORE_BASE_ADDR}->{value};
        $reduced_addr = $hex_addresses[$addr];
        $reg_index = 0;
        $reg_abs = $reduced_addr;
        $reg_name = $reg_names{$reduced_addr};
    } else {
        $base = $const_hash{REG_COMMON_EM_ET_BASE_ADDR}->{value};
        $reduced_addr = $base + ($hex_addresses[$addr] - $base - $const_hash{$group}->{value}) %
            $area_period{$group}->{value};
        $reg_index = int ( ($hex_addresses[$addr] - $base - $const_hash{$group}->{value}) /
                           $area_period{$group}->{value});
        $reg_abs = $reduced_addr + $const_hash{$group}->{value};
        $reg_name = $reg_names{$reduced_addr + $const_hash{$group}->{value}};
    }

    printf "name: $reg_name\[$reg_index\], reduced: 0x%08x (after offset: 0x%08x, group: $group)\n", $reduced_addr, $reg_abs;
}

# output constant values

for ( my $addr = 0; $addr < scalar @consts_of_interest; $addr++ ) {
    print "$consts_of_interest[$addr]=$const_hash{$consts_of_interest[$addr]}->{value}\n";
}

# output constant names

for ( my $addr = 0; $addr < scalar @values_of_interest; $addr++ ) {
    if ( exists $value_lookup{$values_of_interest[$addr]}) {
        printf "Value ($values_of_interest[$addr] 0x%x):\n   ", $values_of_interest[$addr];
        say +(join "\n   ", sort @{$value_lookup{$values_of_interest[$addr]}});
    }
}

__END__

=head1 DIG_OUT

dig_out.pl - Output register and constant information

=head1 SYNOPSIS

dig_out.pl [options] input_file


 Options:
   --help|-h|-?                 brief help message
   --man|-m                     full documentation
   --regaddr=<register address>  look up the register name
                                and index
   --lookup=<const>             look up constant names that
                                have the given value 

=head1 OPTIONS

=over 8

=item B<--help>

Print a brief help message and exit.

=item B<--man>

Print the manual page and exit.

=item B<--regaddr>=<register address>

Look up the register name and index based on the hex address (0x prefix is optional).

=item B<--lookup>=<const>             

Look up constant names that have the given value.
 
=back

=head1 DESCRIPTION

B<dig_out.pl> will read the given <input_file> and output various values
according to the options given.

=cut