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
19use strict;
20use diagnostics;
21$^W = 1;
22
23my $rev = '$Id$';
24$rev =~ s/\$//g;
25$rev =~ s/,v//g;
26$rev =~ s/Id: //;
27
28use Getopt::Std;
29my %options;
30getopts('i:o:', \%options);
31
32my ($binname, $need_uscorefix, $outputfile, $nsyms, $ostype, $nm_prog);
33my %symmap;
34
35$binname = $ARGV[0];
36$need_uscorefix = 0;
37if ($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`;
46chop($ostype);
47if ($ostype eq "SunOS" || $ostype eq "HP-UX") {
48	$nm_prog = "/usr/ccs/bin/nm -x"
49}
50
51if ($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}
57open(TBLFILE, ">$outputfile") || die "failed to open output file: $outputfile";
58
59$nsyms = 0;
60while (<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
98sub 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
112print TBLFILE "/*\n * Generated by $rev \n */\n";
113print TBLFILE "#include <isc/backtrace.h>\n";
114print TBLFILE "const int isc__backtrace_nsymbols = $nsyms;\n";
115print TBLFILE "const isc_backtrace_symmap_t isc__backtrace_symtable[] = {\n";
116foreach (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}
123print TBLFILE "\t{ (void *)0x0, \"\" },\n";
124print TBLFILE "};\n";
125
126close(TBLFILE);
127close(SYMBOLS);
128