external/bsd/bind/dist/util/mksymtbl.pl

   1 #!/usr/bin/env perl
   2 #
   3 # Copyright (C) 2009, 2012  Internet Systems Consortium, Inc. ("ISC")
   4 #
   5 # Permission to use, copy, modify, and/or distribute this software for any
   6 # purpose with or without fee is hereby granted, provided that the above
   7 # copyright notice and this permission notice appear in all copies.
   8 #
   9 # THE SOFTWARE IS PROVIDED "AS IS" AND ISC DISCLAIMS ALL WARRANTIES WITH
  10 # REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY
  11 # AND FITNESS.  IN NO EVENT SHALL ISC BE LIABLE FOR ANY SPECIAL, DIRECT,
  12 # INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM
  13 # LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE
  14 # OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR
  15 # PERFORMANCE OF THIS SOFTWARE.
  16
  17 # Id
  18
  19 use strict;
  20 use diagnostics;
  21 $^W = 1;
  22
  23 my $rev = 'Id';
  24 $rev =~ s/\$//g;
  25 $rev =~ s/,v//g;
  26 $rev =~ s/Id: //;
  27
  28 use Getopt::Std;
  29 my %options;
  30 getopts('i:o:', \%options);
  31
  32 my ($binname, $need_uscorefix, $outputfile, $nsyms, $ostype, $nm_prog);
  33 my %symmap;
  34
  35 $binname = $ARGV[0];
  36 $need_uscorefix = 0;
  37 if ($options{'o'}) {
  38         $outputfile = $options{'o'};
  39 } else {
  40         $outputfile = "symtbl.c";
  41 }
  42
  43 # OS-depending configuration
  44 $nm_prog = "nm";
  45 $ostype = `uname -s`;
  46 chop($ostype);
  47 if ($ostype eq "SunOS" || $ostype eq "HP-UX") {
  48         $nm_prog = "/usr/ccs/bin/nm -x"
  49 }
  50
  51 if ($options{'i'}) {
  52         open(SYMBOLS, $options{'i'}) || die "failed to open $options{'i'}";
  53 } else {
  54         open(SYMBOLS, "$nm_prog $binname |") ||
  55             die "failed to invoke utility to get symbols";
  56 }
  57 open(TBLFILE, ">$outputfile") || die "failed to open output file: $outputfile";
  58
  59 $nsyms = 0;
  60 while (<SYMBOLS>) {
  61         my ($addr, $symbol) = (0, "");
  62         if ($ostype eq "SunOS") {
  63                 if (/\[\d*\]\s*\|\s*0x([0-9a-f]*)\|\s*0x[0-9a-f]*\|FUNC\s*(.*)\|([^|]+)$/) {
  64                         next if ($2 =~ /UNDEF/); # skip undefined symbols
  65                         $addr = $1;
  66                         $symbol = $3;
  67                         chop($symbol);
  68                 }
  69         } elsif ($ostype eq "HP-UX") {
  70                 if (/(\S*)\s*\|0x([0-9a-f]*)\|([^|]*\|entry|extern\|code)/) {
  71                         $addr = $2;
  72                         $symbol = $1;
  73                         # this filter catches a massive number of awkward
  74                         # symbols such as "$START$".  we are not interested in
  75                         # those and ignore them.
  76                         next if ($symbol =~ /\$/);
  77                 }
  78         } else {
  79                 # *BSDs, Linux, etc.
  80                 if (/([0-9a-f]*)\s[tT]\s(.*)/) {
  81                         ($addr, $symbol) = ($1, $2);
  82                         # heuristics: some compilers add a "_" to all program
  83                         # defined symbols.  Detect and fix it for a well known
  84                         # symbol of "main".
  85                         $need_uscorefix = 1 if ($symbol eq "_main");
  86                 }
  87         }
  88         if ($symbol ne "") {
  89                 # XXX: HP-UX's nm can produce a duplicate entry for the same
  90                 # address.  Ignore duplicate entries except the first one.
  91                 next if ($symmap{$addr});
  92
  93                 $symmap{$addr} = $symbol;
  94                 $nsyms++;
  95         }
  96 }
  97
  98 sub lhex {
  99         my $la = substr($a, -8);
 100         my $lb = substr($b, -8);
 101         my $ha = substr($a, 0, length($a) - length($la));
 102         my $hb = substr($b, 0, length($b) - length($lb));
 103         $ha = "0" if ($ha eq "");
 104         $ha = "0" if ($hb eq "");
 105         if (hex($ha) != hex($hb)) {
 106                 $la = $ha;
 107                 $lb = $hb;
 108         }
 109         hex($la) <=> hex($lb)
 110 }
 111
 112 print TBLFILE "/*\n * Generated by $rev \n */\n";
 113 print TBLFILE "#include <isc/backtrace.h>\n";
 114 print TBLFILE "const int isc__backtrace_nsymbols = $nsyms;\n";
 115 print TBLFILE "const isc_backtrace_symmap_t isc__backtrace_symtable[] = {\n";
 116 foreach (sort lhex keys(%symmap)) {
 117         my ($addr, $symbol) = ($_, $symmap{$_});
 118         if ($need_uscorefix && $symbol =~ /^_(.*)/) {
 119                 $symbol = $1;
 120         }
 121         print TBLFILE "\t{ (void *)0x$addr, \"$symbol\" },\n";
 122 }
 123 print TBLFILE "\t{ (void *)0x0, \"\" },\n";
 124 print TBLFILE "};\n";
 125
 126 close(TBLFILE);
 127 close(SYMBOLS);