1------------------------------------------------------------------------------ 2-- -- 3-- GNAT COMPILER COMPONENTS -- 4-- -- 5-- V X A D D R 2 L I N E -- 6-- -- 7-- B o d y -- 8-- -- 9-- Copyright (C) 2002-2013, AdaCore -- 10-- -- 11-- GNAT is free software; you can redistribute it and/or modify it under -- 12-- terms of the GNU General Public License as published by the Free Soft- -- 13-- ware Foundation; either version 3, or (at your option) any later ver- -- 14-- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- 15-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- 16-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- 17-- for more details. You should have received a copy of the GNU General -- 18-- Public License distributed with GNAT; see file COPYING3. If not, go to -- 19-- http://www.gnu.org/licenses for a complete copy of the license. -- 20-- -- 21-- GNAT was originally developed by the GNAT team at New York University. -- 22-- Extensive contributions were provided by Ada Core Technologies Inc. -- 23-- -- 24------------------------------------------------------------------------------ 25 26-- This program is meant to be used with vxworks to compute symbolic 27-- backtraces on the host from non-symbolic backtraces obtained on the target. 28 29-- The basic idea is to automate the computation of the necessary address 30-- adjustments prior to calling addr2line when the application has only been 31-- partially linked on the host. 32 33-- Variants for various targets are supported, and the command line should 34-- be like : 35 36-- <target>-addr2line [-a <target_arch>] <exe_file> <ref_address> 37-- <backtrace addresses> 38 39-- Where: 40-- <target_arch> : 41-- selects the target architecture. In the absence of this parameter the 42-- default variant is chosen based on the Detect_Arch result. Generally, 43-- this parameter will only be used if vxaddr2line is recompiled manually. 44-- Otherwise, the command name will always be of the form 45-- <target>-vxaddr2line where there is no ambiguity on the target's 46-- architecture. 47 48-- <exe_file> : 49-- The name of the partially linked binary file for the application. 50 51-- <ref_address> : 52-- Runtime address (on the target) of a reference symbol you choose, 53-- which name shall match the value of the Ref_Symbol variable declared 54-- below. A symbol with a small offset from the beginning of the text 55-- segment is better, so "adainit" is a good choice. 56 57-- <backtrace addresses> : 58-- The call chain addresses you obtained at run time on the target and 59-- for which you want a symbolic association. 60 61-- TO ADD A NEW ARCHITECTURE add an appropriate value to Architecture type 62-- (in a format <host>_<target>), and then an appropriate value to Config_List 63-- array 64 65with Ada.Text_IO; use Ada.Text_IO; 66with Ada.Command_Line; use Ada.Command_Line; 67with Ada.Strings.Fixed; use Ada.Strings.Fixed; 68with Interfaces; use Interfaces; 69 70with GNAT.OS_Lib; use GNAT.OS_Lib; 71with GNAT.Directory_Operations; use GNAT.Directory_Operations; 72with GNAT.Expect; use GNAT.Expect; 73with GNAT.Regpat; use GNAT.Regpat; 74 75procedure VxAddr2Line is 76 77 package Unsigned_32_IO is new Modular_IO (Unsigned_32); 78 -- Instantiate Modular_IO to have Put 79 80 Ref_Symbol : constant String := "adainit"; 81 -- This is the name of the reference symbol which runtime address shall 82 -- be provided as the <ref_address> argument. 83 84 -- All supported architectures 85 type Architecture is 86 (DEC_ALPHA, 87 LINUX_E500V2, 88 LINUX_I586, 89 LINUX_POWERPC, 90 WINDOWS_E500V2, 91 WINDOWS_I586, 92 WINDOWS_M68K, 93 WINDOWS_POWERPC, 94 SOLARIS_E500V2, 95 SOLARIS_I586, 96 SOLARIS_POWERPC); 97 98 type Arch_Record is record 99 Addr2line_Binary : String_Access; 100 -- Name of the addr2line utility to use 101 102 Nm_Binary : String_Access; 103 -- Name of the host nm utility, which will be used to find out the 104 -- offset of the reference symbol in the text segment of the partially 105 -- linked executable. 106 107 Addr_Digits_To_Skip : Integer; 108 -- When addresses such as 0xfffffc0001dfed50 are provided, for instance 109 -- on ALPHA, indicate the number of leading digits that can be ignored, 110 -- which will avoid computational overflows. Typically only useful when 111 -- 64bit addresses are provided. 112 113 Bt_Offset_From_Call : Unsigned_32; 114 -- Offset from a backtrace address to the address of the corresponding 115 -- call instruction. This should always be 0, except on platforms where 116 -- the backtrace addresses actually correspond to return and not call 117 -- points. In such cases, a negative value is most likely. 118 end record; 119 120 -- Configuration for each of the architectures 121 Arch_List : array (Architecture'Range) of Arch_Record := 122 (DEC_ALPHA => 123 (Addr2line_Binary => null, 124 Nm_Binary => null, 125 Addr_Digits_To_Skip => 8, 126 Bt_Offset_From_Call => 0), 127 LINUX_E500V2 => 128 (Addr2line_Binary => null, 129 Nm_Binary => null, 130 Addr_Digits_To_Skip => 0, 131 Bt_Offset_From_Call => -4), 132 LINUX_I586 => 133 (Addr2line_Binary => null, 134 Nm_Binary => null, 135 Addr_Digits_To_Skip => 0, 136 Bt_Offset_From_Call => -2), 137 LINUX_POWERPC => 138 (Addr2line_Binary => null, 139 Nm_Binary => null, 140 Addr_Digits_To_Skip => 0, 141 Bt_Offset_From_Call => -4), 142 SOLARIS_E500V2 => 143 (Addr2line_Binary => null, 144 Nm_Binary => null, 145 Addr_Digits_To_Skip => 0, 146 Bt_Offset_From_Call => -4), 147 SOLARIS_I586 => 148 (Addr2line_Binary => null, 149 Nm_Binary => null, 150 Addr_Digits_To_Skip => 0, 151 Bt_Offset_From_Call => -2), 152 SOLARIS_POWERPC => 153 (Addr2line_Binary => null, 154 Nm_Binary => null, 155 Addr_Digits_To_Skip => 0, 156 Bt_Offset_From_Call => -4), 157 WINDOWS_E500V2 => 158 (Addr2line_Binary => null, 159 Nm_Binary => null, 160 Addr_Digits_To_Skip => 0, 161 Bt_Offset_From_Call => -4), 162 WINDOWS_I586 => 163 (Addr2line_Binary => null, 164 Nm_Binary => null, 165 Addr_Digits_To_Skip => 0, 166 Bt_Offset_From_Call => -2), 167 WINDOWS_M68K => 168 (Addr2line_Binary => null, 169 Nm_Binary => null, 170 Addr_Digits_To_Skip => 0, 171 Bt_Offset_From_Call => -4), 172 WINDOWS_POWERPC => 173 (Addr2line_Binary => null, 174 Nm_Binary => null, 175 Addr_Digits_To_Skip => 0, 176 Bt_Offset_From_Call => -4) 177 ); 178 179 -- Current architecture 180 Cur_Arch : Architecture; 181 182 -- State of architecture detection 183 Detect_Success : Boolean := False; 184 185 ----------------------- 186 -- Local subprograms -- 187 ----------------------- 188 189 procedure Error (Msg : String); 190 pragma No_Return (Error); 191 -- Prints the message and then terminates the program 192 193 procedure Usage; 194 -- Displays the short help message and then terminates the program 195 196 function Get_Reference_Offset return Unsigned_32; 197 -- Computes the static offset of the reference symbol by calling nm 198 199 function Get_Value_From_Hex_Arg (Arg : Natural) return Unsigned_32; 200 -- Threats the argument number Arg as a C-style hexadecimal literal 201 -- and returns its integer value 202 203 function Hex_Image (Value : Unsigned_32) return String_Access; 204 -- Returns access to a string that contains hexadecimal image of Value 205 206 -- Separate functions that provide build-time customization: 207 208 procedure Detect_Arch; 209 -- Saves in Cur_Arch the current architecture, based on the name of 210 -- vxaddr2line instance and properties of the host. Detect_Success is False 211 -- if detection fails 212 213 ----------------- 214 -- Detect_Arch -- 215 ----------------- 216 217 procedure Detect_Arch is 218 Name : constant String := Base_Name (Command_Name); 219 Proc : constant String := 220 Name (Name'First .. Index (Name, "-") - 1); 221 Target : constant String := 222 Name (Name'First .. Index (Name, "vxaddr2line") - 1); 223 224 begin 225 Detect_Success := False; 226 227 if Proc = "" then 228 return; 229 end if; 230 231 if Proc = "alpha" then 232 Cur_Arch := DEC_ALPHA; 233 else 234 -- Let's detect the host. 235 -- ??? A naive implementation that can't distinguish between Unixes 236 if Directory_Separator = '/' then 237 Cur_Arch := Architecture'Value ("solaris_" & Proc); 238 else 239 Cur_Arch := Architecture'Value ("windows_" & Proc); 240 end if; 241 end if; 242 243 if Arch_List (Cur_Arch).Addr2line_Binary = null then 244 Arch_List (Cur_Arch).Addr2line_Binary := new String' 245 (Target & "addr2line"); 246 end if; 247 if Arch_List (Cur_Arch).Nm_Binary = null then 248 Arch_List (Cur_Arch).Nm_Binary := new String' 249 (Target & "nm"); 250 end if; 251 252 Detect_Success := True; 253 254 exception 255 when others => 256 return; 257 end Detect_Arch; 258 259 ----------- 260 -- Error -- 261 ----------- 262 263 procedure Error (Msg : String) is 264 begin 265 Put_Line (Msg); 266 OS_Exit (1); 267 raise Program_Error; 268 end Error; 269 270 -------------------------- 271 -- Get_Reference_Offset -- 272 -------------------------- 273 274 function Get_Reference_Offset return Unsigned_32 is 275 Nm_Cmd : constant String_Access := 276 Locate_Exec_On_Path (Arch_List (Cur_Arch).Nm_Binary.all); 277 278 Nm_Args : constant Argument_List := 279 (new String'("-P"), 280 new String'(Argument (1))); 281 282 Forever : aliased String := "^@@@@"; 283 Reference : aliased String := Ref_Symbol & "\s+\S\s+([\da-fA-F]+)"; 284 285 Pd : Process_Descriptor; 286 Result : Expect_Match; 287 288 begin 289 -- If Nm is not found, abort 290 291 if Nm_Cmd = null then 292 Error ("Couldn't find " & Arch_List (Cur_Arch).Nm_Binary.all); 293 end if; 294 295 Non_Blocking_Spawn 296 (Pd, Nm_Cmd.all, Nm_Args, Buffer_Size => 0, Err_To_Out => True); 297 298 -- Expect a string containing the reference symbol 299 300 Expect (Pd, Result, 301 Regexp_Array'(1 => Reference'Unchecked_Access), 302 Timeout => -1); 303 304 -- If we are here, the pattern was matched successfully 305 306 declare 307 Match_String : constant String := Expect_Out_Match (Pd); 308 Matches : Match_Array (0 .. 1); 309 Value : Unsigned_32; 310 311 begin 312 Match (Reference, Match_String, Matches); 313 Value := Unsigned_32'Value 314 ("16#" 315 & Match_String (Matches (1).First .. Matches (1).Last) & "#"); 316 317 -- Expect a string that will never be emitted, so that the 318 -- process can be correctly terminated (with Process_Died) 319 320 Expect (Pd, Result, 321 Regexp_Array'(1 => Forever'Unchecked_Access), 322 Timeout => -1); 323 324 exception 325 when Process_Died => 326 return Value; 327 end; 328 329 -- We cannot get here 330 331 raise Program_Error; 332 333 exception 334 when Invalid_Process => 335 Error ("Could not spawn a process " & Nm_Cmd.all); 336 337 when others => 338 339 -- The process died without matching the reference symbol or the 340 -- format wasn't recognized. 341 342 Error ("Unexpected output from " & Nm_Cmd.all); 343 end Get_Reference_Offset; 344 345 ---------------------------- 346 -- Get_Value_From_Hex_Arg -- 347 ---------------------------- 348 349 function Get_Value_From_Hex_Arg (Arg : Natural) return Unsigned_32 is 350 Cur_Arg : constant String := Argument (Arg); 351 Offset : Natural; 352 353 begin 354 -- Skip "0x" prefix if present 355 356 if Cur_Arg'Length > 2 and then Cur_Arg (1 .. 2) = "0x" then 357 Offset := 3; 358 else 359 Offset := 1; 360 end if; 361 362 -- Add architecture-specific offset 363 364 Offset := Offset + Arch_List (Cur_Arch).Addr_Digits_To_Skip; 365 366 -- Convert to value 367 368 return Unsigned_32'Value 369 ("16#" & Cur_Arg (Offset .. Cur_Arg'Last) & "#"); 370 371 exception 372 when Constraint_Error => 373 374 Error ("Can't parse backtrace address '" & Cur_Arg & "'"); 375 raise; 376 end Get_Value_From_Hex_Arg; 377 378 --------------- 379 -- Hex_Image -- 380 --------------- 381 382 function Hex_Image (Value : Unsigned_32) return String_Access is 383 Result : String (1 .. 20); 384 Start_Pos : Natural; 385 386 begin 387 Unsigned_32_IO.Put (Result, Value, 16); 388 Start_Pos := Index (Result, "16#") + 3; 389 return new String'(Result (Start_Pos .. Result'Last - 1)); 390 end Hex_Image; 391 392 ----------- 393 -- Usage -- 394 ----------- 395 396 procedure Usage is 397 begin 398 Put_Line ("Usage : " & Base_Name (Command_Name) 399 & " <executable> <" 400 & Ref_Symbol & " offset on target> <addr1> ..."); 401 402 OS_Exit (1); 403 end Usage; 404 405 Ref_Static_Offset, Ref_Runtime_Address, Bt_Address : Unsigned_32; 406 407 Addr2line_Cmd : String_Access; 408 409 Addr2line_Args : Argument_List (1 .. 501); 410 -- We expect that there won't be more than 500 backtrace frames 411 412 Addr2line_Args_Count : Natural; 413 414 Success : Boolean; 415 416-- Start of processing for VxAddr2Line 417 418begin 419 420 Detect_Arch; 421 422 -- There should be at least two arguments 423 424 if Argument_Count < 2 then 425 Usage; 426 end if; 427 428 -- Enforce HARD LIMIT There should be at most 501 arguments. Why 501??? 429 430 if Argument_Count > 501 then 431 Error ("Too many backtrace frames"); 432 end if; 433 434 -- Do we have a valid architecture? 435 436 if not Detect_Success then 437 Put_Line ("Couldn't detect the architecture"); 438 return; 439 end if; 440 441 Addr2line_Cmd := 442 Locate_Exec_On_Path (Arch_List (Cur_Arch).Addr2line_Binary.all); 443 444 -- If Addr2line is not found, abort 445 446 if Addr2line_Cmd = null then 447 Error ("Couldn't find " & Arch_List (Cur_Arch).Addr2line_Binary.all); 448 end if; 449 450 -- The first argument specifies the image file. Check if it exists 451 452 if not Is_Regular_File (Argument (1)) then 453 Error ("Couldn't find the executable " & Argument (1)); 454 end if; 455 456 -- The second argument specifies the reference symbol runtime address. 457 -- Let's parse and store it 458 459 Ref_Runtime_Address := Get_Value_From_Hex_Arg (2); 460 461 -- Run nm command to get the reference symbol static offset 462 463 Ref_Static_Offset := Get_Reference_Offset; 464 465 -- Build addr2line parameters. First, the standard part 466 467 Addr2line_Args (1) := new String'("--exe=" & Argument (1)); 468 Addr2line_Args_Count := 1; 469 470 -- Now, append to this the adjusted backtraces in arguments 4 and further 471 472 for J in 3 .. Argument_Count loop 473 474 -- Basically, for each address in the runtime backtrace ... 475 476 -- o We compute its offset relatively to the runtime address of the 477 -- reference symbol, 478 479 -- and then ... 480 481 -- o We add this offset to the static one for the reference symbol in 482 -- the executable to find the executable offset corresponding to the 483 -- backtrace address. 484 485 Bt_Address := Get_Value_From_Hex_Arg (J); 486 487 Bt_Address := 488 Bt_Address - Ref_Runtime_Address 489 + Ref_Static_Offset 490 + Arch_List (Cur_Arch).Bt_Offset_From_Call; 491 492 Addr2line_Args_Count := Addr2line_Args_Count + 1; 493 Addr2line_Args (Addr2line_Args_Count) := Hex_Image (Bt_Address); 494 end loop; 495 496 -- Run the resulting command 497 498 Spawn (Addr2line_Cmd.all, 499 Addr2line_Args (1 .. Addr2line_Args_Count), Success); 500 501 if not Success then 502 Error ("Couldn't spawn " & Addr2line_Cmd.all); 503 end if; 504 505exception 506 when others => 507 508 -- Mask all exceptions 509 510 return; 511end VxAddr2Line; 512