summaryrefslogtreecommitdiff
path: root/gcc/ada/vxaddr2line.adb
blob: f1bb48a74289d64648690c2b9fb78bb7bd32cd13 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
------------------------------------------------------------------------------
--                                                                          --
--                         GNAT COMPILER COMPONENTS                         --
--                                                                          --
--                           V X A D D R 2 L I N E                          --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--                     Copyright (C) 2002-2009, AdaCore                     --
--                                                                          --
-- GNAT is free software;  you can  redistribute it  and/or modify it under --
-- terms of the  GNU General Public License as published  by the Free Soft- --
-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
-- for  more details.  You should have  received  a copy of the GNU General --
-- Public License  distributed with GNAT; see file COPYING3.  If not, go to --
-- http://www.gnu.org/licenses for a complete copy of the license.          --
--                                                                          --
-- GNAT was originally developed  by the GNAT team at  New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc.      --
--                                                                          --
------------------------------------------------------------------------------

--  This program is meant to be used with vxworks to compute symbolic
--  backtraces on the host from non-symbolic backtraces obtained on the target.

--  The basic idea is to automate the computation of the necessary address
--  adjustments prior to calling addr2line when the application has only been
--  partially linked on the host.

--  Variants for various targets are supported, and the command line should
--  be like :

--  <target>-addr2line [-a <target_arch>] <exe_file> <ref_address>
--                     <backtrace addresses>

--  Where:
--  <target_arch> :
--    selects the target architecture. In the absence of this parameter the
--    default variant is chosen based on the Detect_Arch result. Generally,
--    this parameter will only be used if vxaddr2line is recompiled manually.
--    Otherwise, the command name will always be of the form
--    <target>-vxaddr2line where there is no ambiguity on the target's
--    architecture.

--  <exe_file> :
--    The name of the partially linked binary file for the application.

--  <ref_address> :
--    Runtime address (on the target) of a reference symbol you choose,
--    which name shall match the value of the Ref_Symbol variable declared
--    below. A symbol with a small offset from the beginning of the text
--    segment is better, so "adainit" is a good choice.

--  <backtrace addresses> :
--    The call chain addresses you obtained at run time on the target and
--    for which you want a symbolic association.

--  TO ADD A NEW ARCHITECTURE add an appropriate value to Architecture type
--  (in a format <host>_<target>), and then an appropriate value to Config_List
--  array

with Ada.Text_IO;       use Ada.Text_IO;
with Ada.Command_Line;  use Ada.Command_Line;
with Ada.Strings.Fixed; use Ada.Strings.Fixed;
with Interfaces;        use Interfaces;

with GNAT.OS_Lib;               use GNAT.OS_Lib;
with GNAT.Directory_Operations; use GNAT.Directory_Operations;
with GNAT.Expect;               use GNAT.Expect;
with GNAT.Regpat;               use GNAT.Regpat;

procedure VxAddr2Line is

   package Unsigned_32_IO is new Modular_IO (Unsigned_32);
   --  Instantiate Modular_IO to have Put

   Ref_Symbol : constant String := "adainit";
   --  This is the name of the reference symbol which runtime address shall
   --  be provided as the <ref_address> argument.

   --  All supported architectures
   type Architecture is
     (SOLARIS_I586,
      WINDOWS_POWERPC,
      WINDOWS_I586,
      WINDOWS_M68K,
      SOLARIS_POWERPC,
      DEC_ALPHA);

   type Arch_Record is record
      Addr2line_Binary : String_Access;
      --  Name of the addr2line utility to use

      Nm_Binary : String_Access;
      --  Name of the host nm utility, which will be used to find out the
      --  offset of the reference symbol in the text segment of the partially
      --  linked executable.

      Addr_Digits_To_Skip : Integer;
      --  When addresses such as 0xfffffc0001dfed50 are provided, for instance
      --  on ALPHA, indicate the number of leading digits that can be ignored,
      --  which will avoid computational overflows. Typically only useful when
      --  64bit addresses are provided.

      Bt_Offset_From_Call : Unsigned_32;
      --  Offset from a backtrace address to the address of the corresponding
      --  call instruction. This should always be 0, except on platforms where
      --  the backtrace addresses actually correspond to return and not call
      --  points. In such cases, a negative value is most likely.
   end record;

   --  Configuration for each of the architectures
   Arch_List : array (Architecture'Range) of Arch_Record :=
     (WINDOWS_POWERPC =>
        (Addr2line_Binary    => null,
         Nm_Binary           => null,
         Addr_Digits_To_Skip => 0,
         Bt_Offset_From_Call => -4),
      WINDOWS_M68K =>
        (Addr2line_Binary    => null,
         Nm_Binary           => null,
         Addr_Digits_To_Skip => 0,
         Bt_Offset_From_Call => -4),
      WINDOWS_I586 =>
        (Addr2line_Binary    => null,
         Nm_Binary           => null,
         Addr_Digits_To_Skip => 0,
         Bt_Offset_From_Call => -2),
      SOLARIS_POWERPC =>
        (Addr2line_Binary    => null,
         Nm_Binary           => null,
         Addr_Digits_To_Skip => 0,
         Bt_Offset_From_Call => 0),
      SOLARIS_I586 =>
        (Addr2line_Binary    => null,
         Nm_Binary           => null,
         Addr_Digits_To_Skip => 0,
         Bt_Offset_From_Call => -2),
      DEC_ALPHA =>
        (Addr2line_Binary    => null,
         Nm_Binary           => null,
         Addr_Digits_To_Skip => 8,
         Bt_Offset_From_Call => 0)
     );

   --  Current architecture
   Cur_Arch : Architecture;

   --  State of architecture detection
   Detect_Success : Boolean := False;

   -----------------------
   -- Local subprograms --
   -----------------------

   procedure Error (Msg : String);
   pragma No_Return (Error);
   --  Prints the message and then terminates the program

   procedure Usage;
   --  Displays the short help message and then terminates the program

   function Get_Reference_Offset return Unsigned_32;
   --  Computes the static offset of the reference symbol by calling nm

   function Get_Value_From_Hex_Arg (Arg : Natural) return Unsigned_32;
   --  Threats the argument number Arg as a C-style hexadecimal literal
   --  and returns its integer value

   function Hex_Image (Value : Unsigned_32) return String_Access;
   --  Returns access to a string that contains hexadecimal image of Value

   --  Separate functions that provide build-time customization:

   procedure Detect_Arch;
   --  Saves in Cur_Arch the current architecture, based on the name of
   --  vxaddr2line instance and properties of the host. Detect_Success is False
   --  if detection fails

   -----------------
   -- Detect_Arch --
   -----------------

   procedure Detect_Arch is
      Name   : constant String := Base_Name (Command_Name);
      Proc   : constant String :=
                 Name (Name'First .. Index (Name, "-") - 1);
      Target : constant String :=
                 Name (Name'First .. Index (Name, "vxaddr2line") - 1);

   begin
      Detect_Success := False;

      if Proc = "" then
         return;
      end if;

      if Proc = "alpha" then
         Cur_Arch := DEC_ALPHA;
      else
         --  Let's detect the host.
         --  ??? A naive implementation that can't distinguish between Unixes
         if Directory_Separator = '/' then
            Cur_Arch := Architecture'Value ("solaris_" & Proc);
         else
            Cur_Arch := Architecture'Value ("windows_" & Proc);
         end if;
      end if;

      if Arch_List (Cur_Arch).Addr2line_Binary = null then
         Arch_List (Cur_Arch).Addr2line_Binary := new String'
           (Target & "addr2line");
      end if;
      if Arch_List (Cur_Arch).Nm_Binary = null then
         Arch_List (Cur_Arch).Nm_Binary := new String'
           (Target & "nm");
      end if;

      Detect_Success := True;

   exception
      when others =>
         return;
   end Detect_Arch;

   -----------
   -- Error --
   -----------

   procedure Error (Msg : String) is
   begin
      Put_Line (Msg);
      OS_Exit (1);
      raise Program_Error;
   end Error;

   --------------------------
   -- Get_Reference_Offset --
   --------------------------

   function Get_Reference_Offset return Unsigned_32 is
      Nm_Cmd  : constant String_Access :=
                  Locate_Exec_On_Path (Arch_List (Cur_Arch).Nm_Binary.all);

      Nm_Args : constant Argument_List :=
                  (new String'("-P"),
                   new String'(Argument (1)));

      Forever   : aliased String := "^@@@@";
      Reference : aliased String := Ref_Symbol & "\s+\S\s+([\da-fA-F]+)";

      Pd     : Process_Descriptor;
      Result : Expect_Match;

   begin
      --  If Nm is not found, abort

      if Nm_Cmd = null then
         Error ("Couldn't find " & Arch_List (Cur_Arch).Nm_Binary.all);
      end if;

      Non_Blocking_Spawn
        (Pd, Nm_Cmd.all, Nm_Args, Buffer_Size => 0, Err_To_Out => True);

      --  Expect a string containing the reference symbol

      Expect (Pd, Result,
              Regexp_Array'(1 => Reference'Unchecked_Access),
              Timeout => -1);

      --  If we are here, the pattern was matched successfully

      declare
         Match_String : constant String := Expect_Out_Match (Pd);
         Matches      : Match_Array (0 .. 1);
         Value        : Unsigned_32;

      begin
         Match (Reference, Match_String, Matches);
         Value := Unsigned_32'Value
           ("16#"
            & Match_String (Matches (1).First .. Matches (1).Last) & "#");

         --  Expect a string that will never be emitted, so that the
         --  process can be correctly terminated (with Process_Died)

         Expect (Pd, Result,
                 Regexp_Array'(1 => Forever'Unchecked_Access),
                 Timeout => -1);

      exception
         when Process_Died =>
            return Value;
      end;

      --  We cannot get here

      raise Program_Error;

   exception
      when Invalid_Process =>
         Error ("Could not spawn a process " & Nm_Cmd.all);

      when others    =>

         --  The process died without matching the reference symbol or the
         --  format wasn't recognized.

         Error ("Unexpected output from " & Nm_Cmd.all);
   end Get_Reference_Offset;

   ----------------------------
   -- Get_Value_From_Hex_Arg --
   ----------------------------

   function Get_Value_From_Hex_Arg (Arg : Natural) return Unsigned_32 is
      Cur_Arg : constant String := Argument (Arg);
      Offset  : Natural;

   begin
      --  Skip "0x" prefix if present

      if Cur_Arg'Length > 2 and then Cur_Arg (1 .. 2) = "0x" then
         Offset := 3;
      else
         Offset := 1;
      end if;

      --  Add architecture-specific offset

      Offset := Offset + Arch_List (Cur_Arch).Addr_Digits_To_Skip;

      --  Convert to value

      return Unsigned_32'Value
        ("16#" & Cur_Arg (Offset .. Cur_Arg'Last) & "#");

   exception
      when Constraint_Error =>

         Error ("Can't parse backtrace address '" & Cur_Arg & "'");
         raise;
   end Get_Value_From_Hex_Arg;

   ---------------
   -- Hex_Image --
   ---------------

   function Hex_Image (Value : Unsigned_32) return String_Access is
      Result    : String (1 .. 20);
      Start_Pos : Natural;

   begin
      Unsigned_32_IO.Put (Result, Value, 16);
      Start_Pos := Index (Result, "16#") + 3;
      return new String'(Result (Start_Pos .. Result'Last - 1));
   end Hex_Image;

   -----------
   -- Usage --
   -----------

   procedure Usage is
   begin
      Put_Line ("Usage : " & Base_Name (Command_Name)
                & " <executable> <"
                & Ref_Symbol & " offset on target> <addr1> ...");

      OS_Exit (1);
   end Usage;

   Ref_Static_Offset, Ref_Runtime_Address, Bt_Address : Unsigned_32;

   Addr2line_Cmd : String_Access;

   Addr2line_Args : Argument_List (1 .. 501);
   --  We expect that there won't be more than 500 backtrace frames

   Addr2line_Args_Count : Natural;

   Success : Boolean;

--  Start of processing for VxAddr2Line

begin

   Detect_Arch;

   --  There should be at least two arguments

   if Argument_Count < 2 then
      Usage;
   end if;

   --  ??? HARD LIMIT! There should be at most 501 arguments

   if Argument_Count > 501 then
      Error ("Too many backtrace frames");
   end if;

   --  Do we have a valid architecture?

   if not Detect_Success then
      Put_Line ("Couldn't detect the architecture");
      return;
   end if;

   Addr2line_Cmd :=
     Locate_Exec_On_Path (Arch_List (Cur_Arch).Addr2line_Binary.all);

   --  If Addr2line is not found, abort

   if Addr2line_Cmd = null then
      Error ("Couldn't find " & Arch_List (Cur_Arch).Addr2line_Binary.all);
   end if;

   --  The first argument specifies the image file. Check if it exists

   if not Is_Regular_File (Argument (1)) then
      Error ("Couldn't find the executable " & Argument (1));
   end if;

   --  The second argument specifies the reference symbol runtime address.
   --  Let's parse and store it

   Ref_Runtime_Address := Get_Value_From_Hex_Arg (2);

   --  Run nm command to get the reference symbol static offset

   Ref_Static_Offset := Get_Reference_Offset;

   --  Build addr2line parameters. First, the standard part

   Addr2line_Args (1) := new String'("--exe=" & Argument (1));
   Addr2line_Args_Count := 1;

   --  Now, append to this the adjusted backtraces in arguments 4 and further

   for J in 3 .. Argument_Count loop

      --  Basically, for each address in the runtime backtrace ...

      --  o We compute its offset relatively to the runtime address of the
      --    reference symbol,

      --  and then ...

      --  o We add this offset to the static one for the reference symbol in
      --    the executable to find the executable offset corresponding to the
      --    backtrace address.

      Bt_Address := Get_Value_From_Hex_Arg (J);

      Bt_Address :=
        Bt_Address - Ref_Runtime_Address
                   + Ref_Static_Offset
                   + Arch_List (Cur_Arch).Bt_Offset_From_Call;

      Addr2line_Args_Count := Addr2line_Args_Count + 1;
      Addr2line_Args (Addr2line_Args_Count) := Hex_Image (Bt_Address);
   end loop;

   --  Run the resulting command

   Spawn (Addr2line_Cmd.all,
          Addr2line_Args (1 .. Addr2line_Args_Count), Success);

   if not Success then
      Error ("Couldn't spawn " & Addr2line_Cmd.all);
   end if;

exception
   when others =>

      --  Mask all exceptions

      return;
end VxAddr2Line;