Import bk_ble from elektroda forum

https://www.elektroda.com/rtvforum/topic3989434.html\#20742145

1 files changed, 241 insertions, 0 deletions

diff --git a/scripts/perl/dig_out.pl b/scripts/perl/dig_out.pl
new file mode 100755
index 0000000..05196d6
--- /dev/null
+++ b/scripts/perl/dig_out.pl
@@ -0,0 +1,241 @@
+#!/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