Ticket #80: mapsymw.pl

File mapsymw.pl, 9.5 KB (added by stevenhl, 16 years ago)

Enhanced wat2map - requires perl

Line 
1#!perl -w
2# mapsymw - mapsym Watcom map files
3
4# Copyright (c) 2007 Steven Levine and Associates, Inc.
5# All rights reserved.
6
7# $TLIB$: $ &(#) %n - Ver %v, %f $
8# TLIB: $ $
9
10# This program is free software licensed under the terms of the GNU
11# General Public License.  The GPL Software License can be found in
12# gnugpl2.txt or at http://www.gnu.org/licenses/licenses.html#GPL
13
14# 02 Jul 07 SHL Baseline
15# 02 Jul 07 SHL Adapt from mapsymb.pl
16# 28 Jul 07 SHL Relax module name detect
17# 30 Jul 07 SHL Auto-trim libstdc++ symbols from libc06x maps
18# 09 Aug 07 SHL Generate dummy symbol for interior segments with no symbols
19
20# mapsym requires each segment to have at least 1 symbol
21# mapsym requires 32 bit segments to have at least 1 symbol with offset > 65K
22# we generate dummy symbols to enforce this
23# mapsym does not understand segment 0
24# we generate Imp flags to support this
25
26use strict;
27use warnings;
28
29# use Package::Subpackage Options;
30use POSIX qw(strftime);
31use Getopt::Std;
32use File::Spec;
33use File::Basename;
34
35our $g_version = '0.1';
36
37our $g_cmdname;
38our $g_tmpdir;
39our @g_mapfiles;                        # All map files
40our $g_mapfile;                         # Current .map file name
41
42&initialize;
43
44our %g_opts;
45
46&scan_args;
47
48print "\n";
49
50foreach $g_mapfile (@g_mapfiles) {
51  &mapsym;
52}
53
54exit;
55
56# end main
57
58#=== initialize() Intialize globals ===
59
60sub initialize {
61
62  &set_cmd_name;
63  &get_tmp_dir;
64
65} # initialize
66
67#=== mapsym() Generate work file, run mapsym on work file ===
68
69sub mapsym {
70
71  # Isolate map file basename
72  my $mapid = basename($g_mapfile);
73  $mapid =~ s/\.[^.]*$//;               # Strip ext
74  verbose_msg("\nProcessing $mapid");
75
76  fatal("$g_mapfile does not exist.") if ! -f $g_mapfile;
77
78  open MAPFILE, $g_mapfile or die "open $g_mapfile $!";
79
80  my $g_wrkfile = File::Spec->catfile($g_tmpdir, "$mapid.map");
81  unlink $g_wrkfile || die "unlink $g_wrkfile $!" if -f $g_wrkfile;
82  open WRKFILE, ">$g_wrkfile" or die "open $g_wrkfile $!";
83
84  my $modname;
85  my $state = '';
86  my $segcnt = 0;
87  my $symcnt = 0;
88  my $is32bit;
89  my %segsinfo;
90  my $segnum;
91  my $offset;
92  my $segaddr;
93  my $imp;
94
95  my $segfmt;
96  my $symfmt;
97
98  while (<MAPFILE>) {
99
100    chomp;                      # EOL
101
102    if (/Executable Image: (\S+)\.\w+$/) {
103      $modname = $1;
104      print WRKFILE "Generated by $g_cmdname from $g_mapfile on ",
105                    strftime('%A, %B %d, %Y at %I:%M %p', localtime), "\n\n";
106      print WRKFILE " $modname\n";
107    }
108
109    $state = 'segments'
110      if /Segment                Class          Group          Address         Size/;
111
112    $state = 'addresses' if /Address        Symbol/;
113
114    # Skip don't cares
115    next if /^=/;
116    next if /^ /;
117    next if /^ /;
118
119    if ($state eq 'segments') {
120      # In
121      # Segment                Class          Group          Address         Size
122      # _TEXT16                CODE           AUTO           0001:00000000   00000068
123      # Out
124      # 0        1         2         3         4         5         6
125      # 123456789012345678901234567890123456789012345678901234567890
126      #  Start         Length     Name                   Class
127      #  0001:00000000 000000030H _MSGSEG32              CODE 32-bit
128
129      if (/^(\w+)\s+(\w+)\s+\w+\s+([[:xdigit:]]+):([[:xdigit:]]+)\s+([[:xdigit:]]+)$/) {
130        my $segname = $1;
131        my $class = $2;
132        $segnum = $3;                   # Has leading 0's
133        $offset = $4;
134        my $seglen = $5;
135
136        $segaddr = "$segnum:$offset";
137
138        if (!$segcnt) {
139          $is32bit = length($offset) == 8;
140          print WRKFILE "\n";
141          if ($is32bit) {
142            print WRKFILE " Start         Length     Name                   Class\n";
143            $segfmt = " %13s 0%8sH %-22s %s\n";
144            $symfmt = " %13s  %3s  %s\n";
145          } else {
146            print WRKFILE " Start     Length Name                   Class\n";
147            $segfmt = " %9s 0%4sH %-22s %s\n";
148            $symfmt = " %9s  %3s  %s\n";
149          }
150        }
151
152        $seglen = substr($5, -4) if !$is32bit;
153
154        printf WRKFILE $segfmt, $segaddr, $seglen, $segname, $class;
155        $segcnt++;
156      }
157    } # if segments
158
159    if ($state eq 'addresses') {
160      # In
161      # Address        Symbol
162      # 0002:0004ae46+ ArcTextProc
163      # Out
164      # 0        1         2         3         4         5         6
165      # 123456789012345678901234567890123456789012345678901234567890
166      #  Address         Publics by Value
167      #  0000:00000000  Imp  WinEmptyClipbrd      (PMWIN.733)
168      #  0002:0001ED40       __towlower_dummy
169      if (/^([[:xdigit:]]+):([[:xdigit:]]+)[+*]?\s+(\w+)$/) {
170        $segnum = $1;
171        $offset = $2;
172        my $sym = $3;
173
174        my $seginfo;
175        if (defined($segsinfo{$1})) {
176          $seginfo = $segsinfo{$1};
177        }
178        else {
179          $seginfo = {max_offset => 0,
180                      symcnt => 0};
181        }
182
183        my $n = hex $offset;
184        $seginfo->{max_offset} = $n if $n > $seginfo->{max_offset};
185        $seginfo->{symcnt}++;
186
187        $segsinfo{$1} = $seginfo;
188
189        $segaddr = "$segnum:$offset";
190
191        $imp = $segnum eq '0000' ? 'Imp' : '';
192
193        # Convert C++ symbols to something mapsym will accept
194
195        $_ = $sym;
196
197        s/\bIdle\b/    /;       # Drop Idle keyword
198        s/\(.*\).*$//;          # Drop (... tails
199
200        s/::~/_x/;              # Replace ::~ with _x
201        s/::/_/;                # Replace :: with _
202
203        s/[<,]/_/g;             # Replace < and , with _
204        s/[>]//g;               # Replace <> with nothing
205        s/[\[\]]//g;            # Replace [] with nothing
206        s/_*$//;                # Drop trailing _
207
208        # Prune to avoid mapsym overflows
209        if ($mapid =~ /libc06/) {
210          # 0001:000b73e0  __ZNSt7codecvtIcc11__mbstate_tEC2Ej
211          # next if / [0-9A-F]{4}:[0-9A-F]{8} {7}S/;
212          next if /\b__Z/;              # Prune libstdc++
213        }
214
215        if (!$symcnt) {
216          print WRKFILE "\n";
217          if ($is32bit) {
218            print WRKFILE " Address         Publics by Value\n";
219          } else {
220            print WRKFILE " Address     Publics by Value\n";
221          }
222        }
223
224        printf WRKFILE $symfmt, $segaddr, $imp, $_;
225        $symcnt++;
226      }
227    } # if addresses
228
229  } # while lines
230
231  close MAPFILE;
232
233  # Generate dummy symbols as needed
234
235  my @keys = sort keys %segsinfo;
236  if (@keys) {
237    my $maxseg = pop @keys;
238    @keys = '0000'..$maxseg;
239  }
240
241  foreach $segnum (@keys) {
242    if ($segnum != 0) {
243      my $seginfo;
244      if (defined($segsinfo{$segnum})) {
245        $seginfo = $segsinfo{$segnum};
246      }
247      else {
248        $seginfo = {max_offset => 0,
249                    symcnt => 0};
250      }
251      if ($seginfo->{symcnt} == 0) {
252        warn "Segment $segnum has no symbols - generating dummy symbol\n";
253        $_ = "Seg${segnum}_dummy";
254        if ($is32bit) {
255          $segaddr = "$segnum:00010000";
256        } else {
257          $segaddr = "$segnum:0000";
258        }
259        $imp = '';
260        printf WRKFILE $symfmt, $segaddr, $imp, $_;
261        $symcnt++;
262      } elsif ($is32bit && $seginfo->{max_offset} < 0x10000) {
263        warn "32 bit segment $segnum is smaller than 64K - generating dummy symbol\n";
264        $_ = "Seg${segnum}_dummy";
265        $segaddr = "$segnum:00010000";
266        $imp = '';
267        printf WRKFILE $symfmt, $segaddr, $imp, $_;
268        $symcnt++;
269      }
270    }
271  } # foreach
272
273  close WRKFILE;
274
275  die "Can not locate module name.  $g_mapfile is probably not a Watcom map file\n" if !defined($modname);
276
277  my $symfile = "$mapid.sym";
278  unlink $symfile || die "unlink $symfile $!" if -f $symfile;
279
280  warn "Processed $segcnt segments and $symcnt symbols for $modname\n";
281
282  system("mapsym $g_wrkfile");
283
284} # mapsym
285
286#=== scan_args(cmdLine) Scan command line ===
287
288sub scan_args {
289
290  getopts('dhtvV', \%g_opts) || &usage;
291
292  &help if $g_opts{h};
293
294  if ($g_opts{V}) {
295    print "$g_cmdname v$g_version";
296    exit;
297  }
298
299  my $arg;
300
301  for $arg (@ARGV) {
302    my @maps = glob($arg);
303    usage("File $arg not found") if @maps == 0;
304    push @g_mapfiles, @maps;
305  } # for arg
306
307} # scan_args
308
309#=== help() Display scan_args usage help exit routine ===
310
311sub help {
312
313  print <<EOD;
314Generate .sym file for Watcom map files.
315Generates temporary map file reformatted for mapsym and
316invokes mapsym to process this map file.
317
318Usage: $g_cmdname [-d] [-h] [-v] [-V] mapfile...
319 -d      Display debug messages
320 -h      Display this message
321 -v      Display progress messages
322 -V      Display version
323
324 mapfile List of map files to process
325EOD
326
327  exit 255;
328
329} # help
330
331#=== usage(message) Report Scanargs usage error exit routine ===
332
333sub usage {
334
335  my $msg = shift;
336  print "\n$msg\n" if $msg;
337print <<EOD;
338
339Usage: $g_cmdname [-d] [-h] [-v] [-V] mapfile...
340EOD
341  exit 255;
342
343} # usage
344
345#==========================================================================
346#=== SkelFunc standards - Delete unused - Move modified above this mark ===
347#==========================================================================
348
349#=== verbose_msg(message) Display message if verbose ===
350
351sub verbose_msg {
352  if ($g_opts{v}) {
353    my $msg = shift;
354    if (defined $msg) {
355      print STDOUT "$msg\n";
356    } else {
357      print STDOUT "\n";
358    }
359  }
360} # verbose_msg
361
362#==========================================================================
363#=== SkelPerl standards - Delete unused - Move modified above this mark ===
364#==========================================================================
365
366#=== fatal(message) Report fatal error and exit ===
367
368sub fatal {
369  my $msg = shift;
370  print "\n";
371  print STDERR "$g_cmdname: $msg\a\n";
372  exit 254;
373
374} # fatal
375
376#=== set_cmd_name() Set $g_cmdname to script name less path and extension ===
377
378sub set_cmd_name {
379  $g_cmdname = $0;
380  $g_cmdname = basename($g_cmdname);
381  $g_cmdname =~ s/\.[^.]*$//;           # Chop ext
382
383} # set_cmd_name
384
385#=== get_tmp_dir() Get TMP dir name with trailing backslash, set Gbl. ===
386
387sub get_tmp_dir {
388
389  $g_tmpdir = File::Spec->tmpdir();
390  die "Need to have TMP or TMPDIR or TEMP defined" unless $g_tmpdir;
391
392} # get_tmp_dir
393
394# The end