"Fossies" - the Fresh Open Source Software Archive

Member "bind-9.11.23/util/mksymtbl.pl" (7 Sep 2020, 3157 Bytes) of package /linux/misc/dns/bind9/9.11.23/bind-9.11.23.tar.gz:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Perl source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file. For more information about "mksymtbl.pl" see the Fossies "Dox" file reference documentation.

    1 #!/usr/bin/env perl
    2 #
    3 # Copyright (C) Internet Systems Consortium, Inc. ("ISC")
    4 #
    5 # This Source Code Form is subject to the terms of the Mozilla Public
    6 # License, v. 2.0. If a copy of the MPL was not distributed with this
    7 # file, You can obtain one at http://mozilla.org/MPL/2.0/.
    8 #
    9 # See the COPYRIGHT file distributed with this work for additional
   10 # information regarding copyright ownership.
   11 
   12 use strict;
   13 use diagnostics;
   14 $^W = 1;
   15 
   16 my $rev = '$Id$';
   17 $rev =~ s/\$//g;
   18 $rev =~ s/,v//g;
   19 $rev =~ s/Id: //;
   20 
   21 use Getopt::Std;
   22 my %options;
   23 getopts('i:o:', \%options);
   24 
   25 my ($binname, $need_uscorefix, $outputfile, $nsyms, $ostype, $nm_prog);
   26 my %symmap;
   27 
   28 $binname = $ARGV[0];
   29 $need_uscorefix = 0;
   30 if ($options{'o'}) {
   31     $outputfile = $options{'o'};
   32 } else {
   33     $outputfile = "symtbl.c";
   34 }
   35 
   36 # OS-depending configuration
   37 $nm_prog = "nm";
   38 $ostype = `uname -s`;
   39 chop($ostype);
   40 if ($ostype eq "SunOS" || $ostype eq "HP-UX") {
   41     $nm_prog = "/usr/ccs/bin/nm -x"
   42 }
   43 
   44 if ($options{'i'}) {
   45     open(SYMBOLS, $options{'i'}) || die "failed to open $options{'i'}";
   46 } else {
   47     open(SYMBOLS, "$nm_prog $binname |") ||
   48         die "failed to invoke utility to get symbols";
   49 }
   50 open(TBLFILE, ">$outputfile") || die "failed to open output file: $outputfile";
   51 
   52 $nsyms = 0;
   53 while (<SYMBOLS>) {
   54     my ($addr, $symbol) = (0, "");
   55     if ($ostype eq "SunOS") {
   56         if (/\[\d*\]\s*\|\s*0x([0-9a-f]*)\|\s*0x[0-9a-f]*\|FUNC\s*(.*)\|([^|]+)$/) {
   57             next if ($2 =~ /UNDEF/); # skip undefined symbols
   58             $addr = $1;
   59             $symbol = $3;
   60             chop($symbol);
   61         }
   62     } elsif ($ostype eq "HP-UX") {
   63         if (/(\S*)\s*\|0x([0-9a-f]*)\|([^|]*\|entry|extern\|code)/) {
   64             $addr = $2;
   65             $symbol = $1;
   66             # this filter catches a massive number of awkward
   67             # symbols such as "$START$".  we are not interested in
   68             # those and ignore them.
   69             next if ($symbol =~ /\$/);
   70         }
   71     } else {
   72         # *BSDs, Linux, etc.
   73         if (/([0-9a-f]*)\s[tT]\s(.*)/) {
   74             ($addr, $symbol) = ($1, $2);
   75             # heuristics: some compilers add a "_" to all program
   76             # defined symbols.  Detect and fix it for a well known
   77             # symbol of "main".
   78             $need_uscorefix = 1 if ($symbol eq "_main");
   79         }
   80     }
   81     if ($symbol ne "") {
   82         # XXX: HP-UX's nm can produce a duplicate entry for the same
   83         # address.  Ignore duplicate entries except the first one.
   84         next if ($symmap{$addr});
   85 
   86         $symmap{$addr} = $symbol;
   87         $nsyms++;
   88     }
   89 }
   90 
   91 sub lhex {
   92     my $la = substr($a, -8);
   93     my $lb = substr($b, -8);
   94     my $ha = substr($a, 0, length($a) - length($la));
   95     my $hb = substr($b, 0, length($b) - length($lb));
   96     $ha = "0" if ($ha eq "");
   97     $ha = "0" if ($hb eq "");
   98     if (hex($ha) != hex($hb)) {
   99         $la = $ha;
  100         $lb = $hb;
  101     }
  102     hex($la) <=> hex($lb)
  103 }
  104 
  105 print TBLFILE "/*\n * Generated by $rev \n */\n";
  106 print TBLFILE "#include <isc/backtrace.h>\n";
  107 print TBLFILE "const int isc__backtrace_nsymbols = $nsyms;\n";
  108 print TBLFILE "const isc_backtrace_symmap_t isc__backtrace_symtable[] = {\n";
  109 foreach (sort lhex keys(%symmap)) {
  110     my ($addr, $symbol) = ($_, $symmap{$_});
  111     if ($need_uscorefix && $symbol =~ /^_(.*)/) {
  112         $symbol = $1;
  113     }
  114     print TBLFILE "\t{ (void *)0x$addr, \"$symbol\" },\n";
  115 }
  116 print TBLFILE "\t{ (void *)0x0, \"\" },\n";
  117 print TBLFILE "};\n";
  118 
  119 close(TBLFILE);
  120 close(SYMBOLS);