1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
5 -- S Y S T E M . D W A R F _ L I N E S --
9 -- Copyright (C) 2009-2023, Free Software Foundation, Inc. --
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. --
18 -- As a special exception under Section 7 of GPL version 3, you are granted --
19 -- additional permissions described in the GCC Runtime Library Exception, --
20 -- version 3.1, as published by the Free Software Foundation. --
22 -- You should have received a copy of the GNU General Public License and --
23 -- a copy of the GCC Runtime Library Exception along with this program; --
24 -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
25 -- <http://www.gnu.org/licenses/>. --
27 -- GNAT was originally developed by the GNAT team at New York University. --
28 -- Extensive contributions were provided by Ada Core Technologies Inc. --
30 ------------------------------------------------------------------------------
32 with Ada
.Characters
.Handling
;
33 with Ada
.Containers
.Generic_Array_Sort
;
34 with Ada
.Unchecked_Deallocation
;
36 with Interfaces
; use Interfaces
;
38 with System
.Address_Image
;
39 with System
.Bounded_Strings
; use System
.Bounded_Strings
;
40 with System
.IO
; use System
.IO
;
41 with System
.Mmap
; use System
.Mmap
;
42 with System
.Object_Reader
; use System
.Object_Reader
;
43 with System
.Storage_Elements
; use System
.Storage_Elements
;
45 package body System
.Dwarf_Lines
is
47 subtype Offset
is Object_Reader
.Offset
;
49 function "-" (Left
, Right
: Address
) return uint32
;
50 pragma Import
(Intrinsic
, "-");
51 -- Return the difference between two addresses as an unsigned offset
53 function Get_Load_Displacement
(C
: Dwarf_Context
) return Storage_Offset
;
54 -- Return the displacement between the load address present in the binary
55 -- and the run-time address at which it is loaded (i.e. non-zero for PIE).
57 function String_Length
(Str
: Str_Access
) return Natural;
58 -- Return the length of the C string Str
60 ---------------------------------
61 -- DWARF Parser Implementation --
62 ---------------------------------
64 procedure Read_Initial_Length
65 (S
: in out Mapped_Stream
;
68 -- Read initial length as specified by 7.2.2
70 procedure Read_Section_Offset
71 (S
: in out Mapped_Stream
;
74 -- Read a section offset, as specified by 7.4
76 procedure Read_Entry_Format_Array
77 (S
: in out Mapped_Stream
;
78 A
: out Entry_Format_Array
;
80 -- Read an entry format array, as specified by 6.2.4.1
82 procedure Read_Aranges_Entry
83 (C
: in out Dwarf_Context
;
86 Len
: out Storage_Count
);
87 -- Read a single .debug_aranges pair
89 procedure Read_Aranges_Header
90 (C
: in out Dwarf_Context
;
91 Info_Offset
: out Offset
;
92 Addr_Size
: out Natural;
93 Success
: out Boolean);
94 -- Read .debug_aranges header
96 procedure Aranges_Lookup
97 (C
: in out Dwarf_Context
;
99 Info_Offset
: out Offset
;
100 Success
: out Boolean);
101 -- Search for Addr in .debug_aranges and return offset Info_Offset in
105 (S
: in out Mapped_Stream
;
109 -- Advance offset in S for Form.
111 procedure Seek_Abbrev
112 (C
: in out Dwarf_Context
;
113 Abbrev_Offset
: Offset
;
114 Abbrev_Num
: uint32
);
115 -- Seek to abbrev Abbrev_Num (starting from Abbrev_Offset)
117 procedure Debug_Info_Lookup
118 (C
: in out Dwarf_Context
;
119 Info_Offset
: Offset
;
120 Line_Offset
: out Offset
;
121 Success
: out Boolean);
122 -- Search for stmt_list tag in Info_Offset and set Line_Offset to the
123 -- offset in .debug_lines. Only look at the first DIE, which should be
124 -- a compilation unit.
126 procedure Initialize_Pass
(C
: in out Dwarf_Context
);
127 -- Seek to the first byte of the first header and prepare to make a pass
128 -- over the line number entries.
130 procedure Initialize_State_Machine
(C
: in out Dwarf_Context
);
131 -- Set all state machine registers to their specified initial values
133 procedure Parse_Header
(C
: in out Dwarf_Context
);
134 -- Decode a DWARF statement program header
136 procedure Read_And_Execute_Insn
137 (C
: in out Dwarf_Context
;
139 -- Read an execute a statement program instruction
141 function To_File_Name
142 (C
: in out Dwarf_Context
;
143 File
: uint32
) return String;
144 -- Extract a file name from the header
146 type Callback
is not null access procedure (C
: in out Dwarf_Context
);
147 procedure For_Each_Row
(C
: in out Dwarf_Context
; F
: Callback
);
148 -- Traverse each .debug_line entry with a callback
150 procedure Dump_Row
(C
: in out Dwarf_Context
);
153 function "<" (Left
, Right
: Search_Entry
) return Boolean;
154 -- For sorting Search_Entry
156 procedure Sort_Search_Array
is new Ada
.Containers
.Generic_Array_Sort
157 (Index_Type
=> Natural,
158 Element_Type
=> Search_Entry
,
159 Array_Type
=> Search_Array
);
161 procedure Symbolic_Address
162 (C
: in out Dwarf_Context
;
164 Dir_Name
: out Str_Access
;
165 File_Name
: out Str_Access
;
166 Subprg_Name
: out String_Ptr_Len
;
167 Line_Num
: out Natural);
168 -- Symbolize one address
170 -----------------------
171 -- DWARF constants --
172 -----------------------
174 -- 3.1.1 Full and Partial Compilation Unit Entries
176 DW_TAG_Compile_Unit
: constant := 16#
11#
;
178 DW_AT_Stmt_List
: constant := 16#
10#
;
180 -- 6.2.4.1 Standard Content Descriptions (DWARF 5)
182 DW_LNCT_path
: constant := 1;
183 DW_LNCT_directory_index
: constant := 2;
184 -- DW_LNCT_timestamp : constant := 3;
185 -- DW_LNCT_size : constant := 4;
186 DW_LNCT_MD5
: constant := 5;
187 DW_LNCT_lo_user
: constant := 16#
2000#
;
188 DW_LNCT_hi_user
: constant := 16#
3fff#
;
190 -- 6.2.5.2 Standard Opcodes
192 DW_LNS_extended_op
: constant := 0;
193 DW_LNS_copy
: constant := 1;
194 DW_LNS_advance_pc
: constant := 2;
195 DW_LNS_advance_line
: constant := 3;
196 DW_LNS_set_file
: constant := 4;
197 DW_LNS_set_column
: constant := 5;
198 DW_LNS_negate_stmt
: constant := 6;
199 DW_LNS_set_basic_block
: constant := 7;
200 DW_LNS_const_add_pc
: constant := 8;
201 DW_LNS_fixed_advance_pc
: constant := 9;
202 DW_LNS_set_prologue_end
: constant := 10;
203 DW_LNS_set_epilogue_begin
: constant := 11;
204 DW_LNS_set_isa
: constant := 12;
206 -- 6.2.5.3 Extended Opcodes
208 DW_LNE_end_sequence
: constant := 1;
209 DW_LNE_set_address
: constant := 2;
210 DW_LNE_define_file
: constant := 3;
211 DW_LNE_set_discriminator
: constant := 4;
213 -- 7.5.5 Classes and Forms
215 DW_FORM_addr
: constant := 16#
01#
;
216 DW_FORM_block2
: constant := 16#
03#
;
217 DW_FORM_block4
: constant := 16#
04#
;
218 DW_FORM_data2
: constant := 16#
05#
;
219 DW_FORM_data4
: constant := 16#
06#
;
220 DW_FORM_data8
: constant := 16#
07#
;
221 DW_FORM_string
: constant := 16#
08#
;
222 DW_FORM_block
: constant := 16#
09#
;
223 DW_FORM_block1
: constant := 16#
0a#
;
224 DW_FORM_data1
: constant := 16#
0b#
;
225 DW_FORM_flag
: constant := 16#
0c#
;
226 DW_FORM_sdata
: constant := 16#
0d#
;
227 DW_FORM_strp
: constant := 16#
0e#
;
228 DW_FORM_udata
: constant := 16#
0f#
;
229 DW_FORM_ref_addr
: constant := 16#
10#
;
230 DW_FORM_ref1
: constant := 16#
11#
;
231 DW_FORM_ref2
: constant := 16#
12#
;
232 DW_FORM_ref4
: constant := 16#
13#
;
233 DW_FORM_ref8
: constant := 16#
14#
;
234 DW_FORM_ref_udata
: constant := 16#
15#
;
235 DW_FORM_indirect
: constant := 16#
16#
;
236 DW_FORM_sec_offset
: constant := 16#
17#
;
237 DW_FORM_exprloc
: constant := 16#
18#
;
238 DW_FORM_flag_present
: constant := 16#
19#
;
239 DW_FORM_strx
: constant := 16#
1a#
;
240 DW_FORM_addrx
: constant := 16#
1b#
;
241 DW_FORM_ref_sup4
: constant := 16#
1c#
;
242 DW_FORM_strp_sup
: constant := 16#
1d#
;
243 DW_FORM_data16
: constant := 16#
1e#
;
244 DW_FORM_line_strp
: constant := 16#
1f#
;
245 DW_FORM_ref_sig8
: constant := 16#
20#
;
246 DW_FORM_implicit_const
: constant := 16#
21#
;
247 DW_FORM_loclistx
: constant := 16#
22#
;
248 DW_FORM_rnglistx
: constant := 16#
23#
;
249 DW_FORM_ref_sup8
: constant := 16#
24#
;
250 DW_FORM_strx1
: constant := 16#
25#
;
251 DW_FORM_strx2
: constant := 16#
26#
;
252 DW_FORM_strx3
: constant := 16#
27#
;
253 DW_FORM_strx4
: constant := 16#
28#
;
254 DW_FORM_addrx1
: constant := 16#
29#
;
255 DW_FORM_addrx2
: constant := 16#
2a#
;
256 DW_FORM_addrx3
: constant := 16#
2b#
;
257 DW_FORM_addrx4
: constant := 16#
2c#
;
263 function "<" (Left
, Right
: Search_Entry
) return Boolean is
265 return Left
.First
< Right
.First
;
272 procedure Close
(C
: in out Dwarf_Context
) is
273 procedure Unchecked_Deallocation
is new Ada
.Unchecked_Deallocation
276 procedure Unchecked_Deallocation
is new Ada
.Unchecked_Deallocation
278 Search_Array_Access
);
289 Unchecked_Deallocation
(C
.Obj
);
291 Unchecked_Deallocation
(C
.Cache
);
298 procedure Dump
(C
: in out Dwarf_Context
) is
300 For_Each_Row
(C
, Dump_Row
'Access);
307 procedure Dump_Row
(C
: in out Dwarf_Context
) is
308 PC
: constant Integer_Address
:= Integer_Address
(C
.Registers
.Address
);
314 Put
(System
.Address_Image
(To_Address
(PC
)));
316 Put
(To_File_Name
(C
, C
.Registers
.File
));
320 Image
: constant String := uint32
'Image (C
.Registers
.Line
);
322 Put_Line
(Image
(2 .. Image
'Last));
328 procedure Dump_Cache
(C
: Dwarf_Context
) is
329 Cache
: constant Search_Array_Access
:= C
.Cache
;
331 Name
: String_Ptr_Len
;
335 Put_Line
("No cache");
339 for I
in Cache
'Range loop
341 E
: Search_Entry
renames Cache
(I
);
342 Base_Address
: constant System
.Address
:=
343 To_Address
(Integer_Address
(C
.Low
+ Storage_Count
(E
.First
)));
345 Put
(System
.Address_Image
(Base_Address
));
347 Put
(System
.Address_Image
(Base_Address
+ Storage_Count
(E
.Size
)));
349 Put
(System
.Address_Image
(To_Address
(Integer_Address
(E
.Line
))));
351 S
:= Read_Symbol
(C
.Obj
.all, Offset
(E
.Sym
));
352 Name
:= Object_Reader
.Name
(C
.Obj
.all, S
);
353 Put
(String (Name
.Ptr
(1 .. Name
.Len
)));
363 procedure For_Each_Row
(C
: in out Dwarf_Context
; F
: Callback
) is
370 Read_And_Execute_Insn
(C
, Done
);
372 if C
.Registers
.Is_Row
then
380 ---------------------------
381 -- Get_Load_Displacement --
382 ---------------------------
384 function Get_Load_Displacement
(C
: Dwarf_Context
) return Storage_Offset
is
386 if C
.Load_Address
/= Null_Address
then
387 return C
.Load_Address
- Address
(Get_Load_Address
(C
.Obj
.all));
391 end Get_Load_Displacement
;
393 ---------------------
394 -- Initialize_Pass --
395 ---------------------
397 procedure Initialize_Pass
(C
: in out Dwarf_Context
) is
401 Initialize_State_Machine
(C
);
404 ------------------------------
405 -- Initialize_State_Machine --
406 ------------------------------
408 procedure Initialize_State_Machine
(C
: in out Dwarf_Context
) is
410 -- Table 6.4: Line number program initial state
417 Is_Stmt
=> C
.Header
.Default_Is_Stmt
/= 0,
418 Basic_Block
=> False,
419 End_Sequence
=> False,
421 end Initialize_State_Machine
;
427 function Is_Inside
(C
: Dwarf_Context
; Addr
: Address
) return Boolean is
428 Disp
: constant Storage_Offset
:= Get_Load_Displacement
(C
);
431 return Addr
>= C
.Low
+ Disp
and then Addr
<= C
.High
+ Disp
;
438 function Low_Address
(C
: Dwarf_Context
) return Address
is
440 return C
.Low
+ Get_Load_Displacement
(C
);
449 C
: out Dwarf_Context
;
450 Success
: out Boolean)
452 Abbrev
, Aranges
, Lines
, Info
, Line_Str
: Object_Section
;
456 -- Not a success by default
460 -- Open file with In_Exception set so we can control the failure mode
462 C
.Obj
:= Open
(File_Name
, In_Exception
=> True);
465 if C
.In_Exception
then
468 raise Dwarf_Error
with "could not open file";
474 -- Get address bounds for executable code. Note that such code
475 -- might come from multiple sections.
477 Get_Xcode_Bounds
(C
.Obj
.all, Lo
, Hi
);
478 C
.Low
:= Address
(Lo
);
479 C
.High
:= Address
(Hi
);
481 -- Create a stream for debug sections
483 if Format
(C
.Obj
.all) = XCOFF32
then
484 Abbrev
:= Get_Section
(C
.Obj
.all, ".dwabrev");
485 Aranges
:= Get_Section
(C
.Obj
.all, ".dwarnge");
486 Info
:= Get_Section
(C
.Obj
.all, ".dwinfo");
487 Lines
:= Get_Section
(C
.Obj
.all, ".dwline");
488 Line_Str
:= Get_Section
(C
.Obj
.all, ".dwlistr");
490 Abbrev
:= Get_Section
(C
.Obj
.all, ".debug_abbrev");
491 Aranges
:= Get_Section
(C
.Obj
.all, ".debug_aranges");
492 Info
:= Get_Section
(C
.Obj
.all, ".debug_info");
493 Lines
:= Get_Section
(C
.Obj
.all, ".debug_line");
494 Line_Str
:= Get_Section
(C
.Obj
.all, ".debug_line_str");
497 if Abbrev
= Null_Section
498 or else Aranges
= Null_Section
499 or else Info
= Null_Section
500 or else Lines
= Null_Section
503 (CodePeer
, False_Positive
,
504 "test always true", "codepeer got confused");
506 C
.Has_Debug
:= False;
510 C
.Abbrev
:= Create_Stream
(C
.Obj
.all, Abbrev
);
511 C
.Aranges
:= Create_Stream
(C
.Obj
.all, Aranges
);
512 C
.Info
:= Create_Stream
(C
.Obj
.all, Info
);
513 C
.Lines
:= Create_Stream
(C
.Obj
.all, Lines
);
515 -- The .debug_line_str section may be available in DWARF 5
517 if Line_Str
/= Null_Section
then
518 C
.Line_Str
:= Create_Stream
(C
.Obj
.all, Line_Str
);
521 -- All operations are successful, context is valid
530 procedure Parse_Header
(C
: in out Dwarf_Context
) is
531 Header
: Line_Info_Header
renames C
.Header
;
535 -- The most recently read character and the one preceding it
538 -- Destination for reads we don't care about
543 First_Byte_Of_Header
: Offset
;
544 Last_Byte_Of_Header
: Offset
;
546 Standard_Opcode_Lengths
: Opcode_Length_Array
;
547 pragma Unreferenced
(Standard_Opcode_Lengths
);
550 Tell
(C
.Lines
, First_Byte_Of_Header
);
552 Read_Initial_Length
(C
.Lines
, Header
.Unit_Length
, Header
.Is64
);
555 C
.Next_Header
:= Off
+ Header
.Unit_Length
;
557 Header
.Version
:= Read
(C
.Lines
);
559 if Header
.Version
>= 5 then
560 Header
.Address_Size
:= Read
(C
.Lines
);
561 Header
.Segment_Selector_Size
:= Read
(C
.Lines
);
563 Header
.Address_Size
:= 0;
564 Header
.Segment_Selector_Size
:= 0;
567 Header
.Header_Length
:= Read
(C
.Lines
);
568 Tell
(C
.Lines
, Last_Byte_Of_Header
);
569 Last_Byte_Of_Header
:=
570 Last_Byte_Of_Header
+ Offset
(Header
.Header_Length
) - 1;
572 Header
.Minimum_Insn_Length
:= Read
(C
.Lines
);
574 if Header
.Version
>= 4 then
575 Header
.Maximum_Op_Per_Insn
:= Read
(C
.Lines
);
577 Header
.Maximum_Op_Per_Insn
:= 0;
580 Header
.Default_Is_Stmt
:= Read
(C
.Lines
);
581 Header
.Line_Base
:= Read
(C
.Lines
);
582 Header
.Line_Range
:= Read
(C
.Lines
);
583 Header
.Opcode_Base
:= Read
(C
.Lines
);
585 -- Standard_Opcode_Lengths is an array of Opcode_Base bytes specifying
586 -- the number of LEB128 operands for each of the standard opcodes.
588 for J
in 1 .. Integer (Header
.Opcode_Base
- 1) loop
589 Standard_Opcode_Lengths
(J
) := Read
(C
.Lines
);
592 -- The Directories table follows. Up to DWARF 4, this is a list of null
593 -- terminated strings terminated by a null byte. In DWARF 5, this is a
594 -- sequence of Directories_Count entries which are encoded as described
595 -- by the Directory_Entry_Format field. We store its offset for later.
597 if Header
.Version
<= 4 then
598 Tell
(C
.Lines
, Header
.Directories
);
599 Char
:= Read
(C
.Lines
);
604 Char
:= Read
(C
.Lines
);
605 exit when Char
= 0 and Prev
= 0;
610 Header
.Directory_Entry_Format_Count
:= Read
(C
.Lines
);
611 Read_Entry_Format_Array
(C
.Lines
,
612 Header
.Directory_Entry_Format
,
613 Header
.Directory_Entry_Format_Count
);
615 Header
.Directories_Count
:= Read_LEB128
(C
.Lines
);
616 Tell
(C
.Lines
, Header
.Directories
);
617 for J
in 1 .. Header
.Directories_Count
loop
618 for K
in 1 .. Integer (Header
.Directory_Entry_Format_Count
) loop
620 Header
.Directory_Entry_Format
(K
).Form
,
622 Header
.Address_Size
);
627 -- The File_Names table is next. Up to DWARF 4, this is a list of record
628 -- containing a null terminated string for the file name, an unsigned
629 -- LEB128 directory index in the Directories table, an unsigned LEB128
630 -- modification time, and an unsigned LEB128 for the file length; the
631 -- table is terminated by a null byte. In DWARF 5, this is a sequence
632 -- of File_Names_Count entries which are encoded as described by the
633 -- File_Name_Entry_Format field. We store its offset for later decoding.
635 if Header
.Version
<= 4 then
636 Tell
(C
.Lines
, Header
.File_Names
);
638 -- Read the file names
641 Read_C_String
(C
.Lines
, Buf
);
642 exit when Buf
(0) = 0;
643 Dummy
:= Read_LEB128
(C
.Lines
); -- Skip the directory index.
644 Dummy
:= Read_LEB128
(C
.Lines
); -- Skip the modification time.
645 Dummy
:= Read_LEB128
(C
.Lines
); -- Skip the file length.
649 Header
.File_Name_Entry_Format_Count
:= Read
(C
.Lines
);
650 Read_Entry_Format_Array
(C
.Lines
,
651 Header
.File_Name_Entry_Format
,
652 Header
.File_Name_Entry_Format_Count
);
654 Header
.File_Names_Count
:= Read_LEB128
(C
.Lines
);
655 Tell
(C
.Lines
, Header
.File_Names
);
656 for J
in 1 .. Header
.File_Names_Count
loop
657 for K
in 1 .. Integer (Header
.File_Name_Entry_Format_Count
) loop
659 Header
.File_Name_Entry_Format
(K
).Form
,
661 Header
.Address_Size
);
666 -- Check we're where we think we are. This sanity check ensures we think
667 -- the header ends where the header says it does. It we aren't, then we
668 -- have probably gotten out of sync somewhere.
672 if Header
.Unit_Length
/= 0
673 and then Off
/= Last_Byte_Of_Header
+ 1
675 raise Dwarf_Error
with "parse error reading DWARF information";
679 ---------------------------
680 -- Read_And_Execute_Insn --
681 ---------------------------
683 procedure Read_And_Execute_Insn
684 (C
: in out Dwarf_Context
;
688 Extended_Opcode
: uint8
;
689 uint32_Operand
: uint32
;
690 int32_Operand
: int32
;
691 uint16_Operand
: uint16
;
694 Extended_Length
: uint32
;
695 pragma Unreferenced
(Extended_Length
);
697 Obj
: Object_File
renames C
.Obj
.all;
698 Registers
: Line_Info_Registers
renames C
.Registers
;
699 Header
: Line_Info_Header
renames C
.Header
;
703 Registers
.Is_Row
:= False;
705 if Registers
.End_Sequence
then
706 Initialize_State_Machine
(C
);
709 -- If we have reached the next header, read it. Beware of possibly empty
712 -- When testing for the end of section, beware of possible zero padding
713 -- at the end. Bail out as soon as there's not even room for at least a
714 -- DW_LNE_end_sequence, 3 bytes from Off to Off+2. This resolves to
715 -- Off+2 > Last_Offset_Within_Section, that is Off+2 > Section_Length-1,
716 -- or Off+3 > Section_Length.
719 while Off
= C
.Next_Header
loop
720 Initialize_State_Machine
(C
);
723 exit when Off
+ 3 > Length
(C
.Lines
);
726 -- Test whether we're done
730 -- We are finished when we either reach the end of the section, or we
731 -- have reached zero padding at the end of the section.
733 if Header
.Unit_Length
= 0 or else Off
+ 3 > Length
(C
.Lines
) then
738 -- Read and interpret an instruction
740 Opcode
:= Read
(C
.Lines
);
744 if Opcode
= DW_LNS_extended_op
then
745 Extended_Length
:= Read_LEB128
(C
.Lines
);
746 Extended_Opcode
:= Read
(C
.Lines
);
748 case Extended_Opcode
is
749 when DW_LNE_end_sequence
=>
751 -- Mark the end of a sequence of source locations
753 Registers
.End_Sequence
:= True;
754 Registers
.Is_Row
:= True;
756 when DW_LNE_set_address
=>
758 -- Set the program counter to a word
760 Registers
.Address
:= Read_Address
(Obj
, C
.Lines
);
762 when DW_LNE_define_file
=>
766 raise Dwarf_Error
with "DWARF operator not implemented";
768 when DW_LNE_set_discriminator
=>
772 int32_Operand
:= Read_LEB128
(C
.Lines
);
776 -- Fail on an unrecognized opcode
778 raise Dwarf_Error
with "DWARF operator not implemented";
783 elsif Opcode
< Header
.Opcode_Base
then
786 -- Append a row to the line info matrix
789 Registers
.Basic_Block
:= False;
790 Registers
.Is_Row
:= True;
792 -- Add an unsigned word to the program counter
794 when DW_LNS_advance_pc
=>
795 uint32_Operand
:= Read_LEB128
(C
.Lines
);
798 uint64
(uint32_Operand
* uint32
(Header
.Minimum_Insn_Length
));
800 -- Add a signed word to the current source line
802 when DW_LNS_advance_line
=>
803 int32_Operand
:= Read_LEB128
(C
.Lines
);
805 uint32
(int32
(Registers
.Line
) + int32_Operand
);
807 -- Set the current source file
809 when DW_LNS_set_file
=>
810 uint32_Operand
:= Read_LEB128
(C
.Lines
);
811 Registers
.File
:= uint32_Operand
;
813 -- Set the current source column
815 when DW_LNS_set_column
=>
816 uint32_Operand
:= Read_LEB128
(C
.Lines
);
817 Registers
.Column
:= uint32_Operand
;
819 -- Toggle the "is statement" flag. GCC doesn't seem to set this???
821 when DW_LNS_negate_stmt
=>
822 Registers
.Is_Stmt
:= not Registers
.Is_Stmt
;
824 -- Mark the beginning of a basic block
826 when DW_LNS_set_basic_block
=>
827 Registers
.Basic_Block
:= True;
829 -- Advance the program counter as by the special opcode 255
831 when DW_LNS_const_add_pc
=>
835 (((255 - Header
.Opcode_Base
) / Header
.Line_Range
) *
836 Header
.Minimum_Insn_Length
);
838 -- Advance the program counter by a constant
840 when DW_LNS_fixed_advance_pc
=>
841 uint16_Operand
:= Read
(C
.Lines
);
843 Registers
.Address
+ uint64
(uint16_Operand
);
845 -- The following are not implemented and ignored
847 when DW_LNS_set_prologue_end
=>
850 when DW_LNS_set_epilogue_begin
=>
853 when DW_LNS_set_isa
=>
856 -- Anything else is an error
859 raise Dwarf_Error
with "DWARF operator not implemented";
862 -- Decode a special opcode. This is a line and address increment encoded
863 -- in a single byte 'special opcode' as described in 6.2.5.1.
867 Address_Increment
: int32
;
868 Line_Increment
: int32
;
871 Opcode
:= Opcode
- Header
.Opcode_Base
;
873 -- The adjusted opcode is a uint8 encoding an address increment
874 -- and a signed line increment. The upperbound is allowed to be
875 -- greater than int8'last so we decode using int32 directly to
876 -- prevent overflows.
879 int32
(Opcode
/ Header
.Line_Range
) *
880 int32
(Header
.Minimum_Insn_Length
);
882 int32
(Header
.Line_Base
) +
883 int32
(Opcode
mod Header
.Line_Range
);
886 Registers
.Address
+ uint64
(Address_Increment
);
887 Registers
.Line
:= uint32
(int32
(Registers
.Line
) + Line_Increment
);
888 Registers
.Basic_Block
:= False;
889 Registers
.Is_Row
:= True;
896 -- In case of errors during parse, just stop reading
898 Registers
.Is_Row
:= False;
900 end Read_And_Execute_Insn
;
902 ----------------------
903 -- Set_Load_Address --
904 ----------------------
906 procedure Set_Load_Address
(C
: in out Dwarf_Context
; Addr
: Address
) is
908 C
.Load_Address
:= Addr
;
909 end Set_Load_Address
;
915 function To_File_Name
916 (C
: in out Dwarf_Context
;
917 File
: uint32
) return String
923 pragma Unreferenced
(Dir_Idx
);
926 pragma Unreferenced
(Mod_Time
);
929 pragma Unreferenced
(Length
);
931 File_Entry_Format
: Entry_Format_Array
932 renames C
.Header
.File_Name_Entry_Format
;
935 Seek
(C
.Lines
, C
.Header
.File_Names
);
937 -- Find the entry. Note that, up to DWARF 4, the index is 1-based
938 -- whereas, in DWARF 5, it is 0-based.
940 if C
.Header
.Version
<= 4 then
941 for J
in 1 .. File
loop
942 Read_C_String
(C
.Lines
, Buf
);
944 if Buf
(Buf
'First) = 0 then
948 Dir_Idx
:= Read_LEB128
(C
.Lines
);
949 Mod_Time
:= Read_LEB128
(C
.Lines
);
950 Length
:= Read_LEB128
(C
.Lines
);
956 for J
in 0 .. File
loop
957 for K
in 1 .. Integer (C
.Header
.File_Name_Entry_Format_Count
) loop
958 if File_Entry_Format
(K
).C_Type
= DW_LNCT_path
then
959 case File_Entry_Format
(K
).Form
is
960 when DW_FORM_string
=>
961 Read_C_String
(C
.Lines
, Buf
);
963 when DW_FORM_line_strp
=>
964 Read_Section_Offset
(C
.Lines
, Off
, C
.Header
.Is64
);
966 Seek
(C
.Line_Str
, Off
);
967 Read_C_String
(C
.Line_Str
, Buf
);
971 raise Dwarf_Error
with "DWARF form not implemented";
976 File_Entry_Format
(K
).Form
,
978 C
.Header
.Address_Size
);
984 return To_String
(Buf
);
987 -------------------------
988 -- Read_Initial_Length --
989 -------------------------
991 procedure Read_Initial_Length
992 (S
: in out Mapped_Stream
;
1001 if Len32
< 16#ffff_fff0#
then
1003 Len
:= Offset
(Len32
);
1004 elsif Len32
< 16#ffff_ffff#
then
1006 raise Constraint_Error
;
1010 Len
:= Offset
(Len64
);
1012 end Read_Initial_Length
;
1014 -------------------------
1015 -- Read_Section_Offset --
1016 -------------------------
1018 procedure Read_Section_Offset
1019 (S
: in out Mapped_Stream
;
1025 Len
:= Offset
(uint64
'(Read (S)));
1027 Len := Offset (uint32'(Read
(S
)));
1029 end Read_Section_Offset
;
1031 -----------------------------
1032 -- Read_Entry_Format_Array --
1033 -----------------------------
1035 procedure Read_Entry_Format_Array
1036 (S
: in out Mapped_Stream
;
1037 A
: out Entry_Format_Array
;
1040 C_Type
, Form
: uint32
;
1046 for J
in 1 .. Len
loop
1047 C_Type
:= Read_LEB128
(S
);
1048 Form
:= Read_LEB128
(S
);
1051 when DW_LNCT_path
.. DW_LNCT_MD5
=>
1052 if N
not in A
'Range then
1053 raise Dwarf_Error
with "duplicate DWARF content type";
1056 A
(N
) := (C_Type
, Form
);
1059 when DW_LNCT_lo_user
.. DW_LNCT_hi_user
=>
1063 raise Dwarf_Error
with "DWARF content type not implemented";
1066 end Read_Entry_Format_Array
;
1068 --------------------
1069 -- Aranges_Lookup --
1070 --------------------
1072 procedure Aranges_Lookup
1073 (C
: in out Dwarf_Context
;
1075 Info_Offset
: out Offset
;
1076 Success
: out Boolean)
1078 Addr_Size
: Natural;
1081 Seek
(C
.Aranges
, 0);
1083 while Tell
(C
.Aranges
) < Length
(C
.Aranges
) loop
1084 Read_Aranges_Header
(C
, Info_Offset
, Addr_Size
, Success
);
1085 exit when not Success
;
1090 Len
: Storage_Count
;
1092 Read_Aranges_Entry
(C
, Addr_Size
, Start
, Len
);
1093 exit when Start
= 0 and Len
= 0;
1095 and then Addr
< Start
+ Len
1112 (S
: in out Mapped_Stream
;
1120 -- 7.5.5 Classes and Forms
1123 when DW_FORM_addr
=>
1124 Skip
:= Offset
(Ptr_Sz
);
1125 when DW_FORM_block1
=>
1126 Skip
:= Offset
(uint8
'(Read (S)));
1127 when DW_FORM_block2 =>
1128 Skip := Offset (uint16'(Read
(S
)));
1129 when DW_FORM_block4
=>
1130 Skip
:= Offset
(uint32
'(Read (S)));
1131 when DW_FORM_block | DW_FORM_exprloc =>
1132 Skip := Offset (uint32'(Read_LEB128
(S
)));
1146 when DW_FORM_addrx3 | DW_FORM_strx3
=>
1161 when DW_FORM_data16
=>
1163 when DW_FORM_sdata
=>
1165 Val
: constant int32
:= Read_LEB128
(S
);
1166 pragma Unreferenced
(Val
);
1178 Val
: constant uint32
:= Read_LEB128
(S
);
1179 pragma Unreferenced
(Val
);
1183 when DW_FORM_flag_present | DW_FORM_implicit_const
=>
1185 when DW_FORM_ref_addr
1186 | DW_FORM_sec_offset
1191 Skip
:= (if Is64
then 8 else 4);
1192 when DW_FORM_string
=>
1193 while uint8
'(Read (S)) /= 0 loop
1197 when DW_FORM_indirect =>
1198 raise Dwarf_Error with "DW_FORM_indirect not implemented";
1200 raise Dwarf_Error with "DWARF form not implemented";
1203 Seek (S, Tell (S) + Skip);
1210 procedure Seek_Abbrev
1211 (C : in out Dwarf_Context;
1212 Abbrev_Offset : Offset;
1213 Abbrev_Num : uint32)
1218 pragma Unreferenced (Tag, Has_Child);
1221 Seek (C.Abbrev, Abbrev_Offset);
1223 -- 7.5.3 Abbreviations Tables
1226 Abbrev := Read_LEB128 (C.Abbrev);
1228 exit when Abbrev = Abbrev_Num;
1230 Tag := Read_LEB128 (C.Abbrev);
1231 Has_Child := Read (C.Abbrev);
1235 Name : constant uint32 := Read_LEB128 (C.Abbrev);
1236 Form : constant uint32 := Read_LEB128 (C.Abbrev);
1238 pragma Unreferenced (Cst);
1241 -- DW_FORM_implicit_const takes its value from the table
1243 if Form = DW_FORM_implicit_const then
1244 Cst := Read_LEB128 (C.Abbrev);
1247 exit when Name = 0 and then Form = 0;
1253 -----------------------
1254 -- Debug_Info_Lookup --
1255 -----------------------
1257 procedure Debug_Info_Lookup
1258 (C : in out Dwarf_Context;
1259 Info_Offset : Offset;
1260 Line_Offset : out Offset;
1261 Success : out Boolean)
1263 Unit_Length : Offset;
1266 Abbrev_Offset : Offset;
1270 pragma Unreferenced (Has_Child);
1272 pragma Unreferenced (Unit_Type);
1278 Seek (C.Info, Info_Offset);
1280 -- 7.5.1.1 Compilation Unit Header
1282 Read_Initial_Length (C.Info, Unit_Length, Is64);
1284 Version := Read (C.Info);
1286 if Version >= 5 then
1287 Unit_Type := Read (C.Info);
1289 Addr_Sz := Read (C.Info);
1291 Read_Section_Offset (C.Info, Abbrev_Offset, Is64);
1293 elsif Version >= 2 then
1294 Read_Section_Offset (C.Info, Abbrev_Offset, Is64);
1296 Addr_Sz := Read (C.Info);
1305 Abbrev := Read_LEB128 (C.Info);
1306 exit when Abbrev /= 0;
1309 -- Read abbrev table
1311 Seek_Abbrev (C, Abbrev_Offset, Abbrev);
1315 if Read_LEB128 (C.Abbrev) /= uint32'(DW_TAG_Compile_Unit
) then
1319 -- Then the has child flag
1321 Has_Child
:= Read
(C
.Abbrev
);
1325 Name
: constant uint32
:= Read_LEB128
(C
.Abbrev
);
1326 Form
: constant uint32
:= Read_LEB128
(C
.Abbrev
);
1328 exit when Name
= 0 and Form
= 0;
1329 if Name
= DW_AT_Stmt_List
then
1331 when DW_FORM_sec_offset
=>
1332 Read_Section_Offset
(C
.Info
, Line_Offset
, Is64
);
1333 when DW_FORM_data4
=>
1334 Line_Offset
:= Offset
(uint32
'(Read (C.Info)));
1335 when DW_FORM_data8 =>
1336 Line_Offset := Offset (uint64'(Read
(C
.Info
)));
1345 Skip_Form
(C
.Info
, Form
, Is64
, Addr_Sz
);
1349 end Debug_Info_Lookup
;
1351 -------------------------
1352 -- Read_Aranges_Header --
1353 -------------------------
1355 procedure Read_Aranges_Header
1356 (C
: in out Dwarf_Context
;
1357 Info_Offset
: out Offset
;
1358 Addr_Size
: out Natural;
1359 Success
: out Boolean)
1361 Unit_Length
: Offset
;
1371 Read_Initial_Length
(C
.Aranges
, Unit_Length
, Is64
);
1373 Version
:= Read
(C
.Aranges
);
1374 if Version
/= 2 then
1378 Read_Section_Offset
(C
.Aranges
, Info_Offset
, Is64
);
1380 -- Read address_size (ubyte)
1382 Addr_Size
:= Natural (uint8
'(Read (C.Aranges)));
1384 -- Read segment_size (ubyte)
1386 Sz := Read (C.Aranges);
1391 -- Handle alignment on twice the address size
1394 Cur_Off : constant Offset := Tell (C.Aranges);
1395 Align : constant Offset := 2 * Offset (Addr_Size);
1396 Space : constant Offset := Cur_Off mod Align;
1399 Seek (C.Aranges, Cur_Off + Align - Space);
1404 end Read_Aranges_Header;
1406 ------------------------
1407 -- Read_Aranges_Entry --
1408 ------------------------
1410 procedure Read_Aranges_Entry
1411 (C : in out Dwarf_Context;
1412 Addr_Size : Natural;
1413 Start : out Address;
1414 Len : out Storage_Count)
1419 if Addr_Size = 4 then
1423 S := Read (C.Aranges);
1424 L := Read (C.Aranges);
1425 Start := Address (S);
1426 Len := Storage_Count (L);
1429 elsif Addr_Size = 8 then
1433 S := Read (C.Aranges);
1434 L := Read (C.Aranges);
1435 Start := Address (S);
1436 Len := Storage_Count (L);
1440 raise Constraint_Error;
1442 end Read_Aranges_Entry;
1448 procedure Enable_Cache (C : in out Dwarf_Context) is
1449 Cache : Search_Array_Access;
1452 -- Phase 1: count number of symbols.
1453 -- Phase 2: fill the cache.
1458 Xcode_Low : constant uint64 := uint64 (C.Low);
1459 Xcode_High : constant uint64 := uint64 (C.High);
1461 Addr, Prev_Addr : uint32;
1462 Nbr_Symbols : Natural;
1464 for Phase in 1 .. 2 loop
1466 S := First_Symbol (C.Obj.all);
1467 Prev_Addr := uint32'Last;
1468 while S /= Null_Symbol loop
1469 -- Discard symbols of length 0 or located outside of the
1470 -- execution code section outer boundaries.
1472 Sz := uint32 (Size (S));
1476 and then Val >= Xcode_Low
1477 and then Val <= Xcode_High
1479 Addr := uint32 (Val - Xcode_Low);
1481 -- Try to filter symbols at the same address. This is a best
1482 -- effort as they might not be consecutive.
1484 if Addr /= Prev_Addr then
1485 Nbr_Symbols := Nbr_Symbols + 1;
1489 C.Cache (Nbr_Symbols) :=
1492 Sym => uint32 (Off (S)),
1498 S := Next_Symbol (C.Obj.all, S);
1502 -- Allocate the cache
1504 Cache := new Search_Array (1 .. Nbr_Symbols);
1508 pragma Assert (Nbr_Symbols = C.Cache'Last);
1513 Sort_Search_Array (C.Cache.all);
1517 if not C.Has_Debug then
1522 Info_Offset : Offset;
1523 Line_Offset : Offset;
1524 Addr_Size : Natural;
1527 Ar_Len : Storage_Count;
1528 Start, Len : uint32;
1529 First, Last : Natural;
1533 Seek (C.Aranges, 0);
1535 while Tell (C.Aranges) < Length (C.Aranges) loop
1536 Read_Aranges_Header (C, Info_Offset, Addr_Size, Success);
1537 exit when not Success;
1539 Debug_Info_Lookup (C, Info_Offset, Line_Offset, Success);
1540 exit when not Success;
1545 Read_Aranges_Entry (C, Addr_Size, Ar_Start, Ar_Len);
1546 exit when Ar_Start = Null_Address and Ar_Len = 0;
1548 Len := uint32 (Ar_Len);
1549 Start := uint32'(Ar_Start
- C
.Low
);
1551 -- Search START in the array
1553 First
:= Cache
'First;
1555 Mid
:= First
; -- In case of array with one element
1556 while First
< Last
loop
1557 Mid
:= First
+ (Last
- First
) / 2;
1558 if Start
< Cache
(Mid
).First
then
1560 elsif Start
>= Cache
(Mid
).First
+ Cache
(Mid
).Size
then
1569 -- There can be overlapping symbols
1571 while Mid
> Cache
'First
1572 and then Cache
(Mid
- 1).First
<= Start
1573 and then Cache
(Mid
- 1).First
+ Cache
(Mid
- 1).Size
> Start
1577 while Mid
<= Cache
'Last loop
1578 if Start
< Cache
(Mid
).First
+ Cache
(Mid
).Size
1579 and then Start
+ Len
> Cache
(Mid
).First
1581 -- MID is within the bounds
1583 Cache
(Mid
).Line
:= uint32
(Line_Offset
);
1584 elsif Start
+ Len
<= Cache
(Mid
).First
then
1596 ----------------------
1597 -- Symbolic_Address --
1598 ----------------------
1600 procedure Symbolic_Address
1601 (C
: in out Dwarf_Context
;
1603 Dir_Name
: out Str_Access
;
1604 File_Name
: out Str_Access
;
1605 Subprg_Name
: out String_Ptr_Len
;
1606 Line_Num
: out Natural)
1608 procedure Set_Result
(Match
: Line_Info_Registers
);
1609 -- Set results using match
1611 procedure Set_Result
(Match
: Line_Info_Registers
) is
1616 pragma Unreferenced
(Mod_Time
);
1619 pragma Unreferenced
(Length
);
1621 Directory_Entry_Format
: Entry_Format_Array
1622 renames C
.Header
.Directory_Entry_Format
;
1624 File_Entry_Format
: Entry_Format_Array
1625 renames C
.Header
.File_Name_Entry_Format
;
1628 Seek
(C
.Lines
, C
.Header
.File_Names
);
1631 -- Find the entry. Note that, up to DWARF 4, the index is 1-based
1632 -- whereas, in DWARF 5, it is 0-based.
1634 if C
.Header
.Version
<= 4 then
1635 for J
in 1 .. Match
.File
loop
1636 File_Name
:= Read_C_String
(C
.Lines
);
1638 if File_Name
(File_Name
'First) = ASCII
.NUL
then
1639 -- End of file list, so incorrect entry
1643 Dir_Idx
:= Read_LEB128
(C
.Lines
);
1644 Mod_Time
:= Read_LEB128
(C
.Lines
);
1645 Length
:= Read_LEB128
(C
.Lines
);
1654 Seek
(C
.Lines
, C
.Header
.Directories
);
1656 for J
in 1 .. Dir_Idx
loop
1657 Dir_Name
:= Read_C_String
(C
.Lines
);
1659 if Dir_Name
(Dir_Name
'First) = ASCII
.NUL
then
1660 -- End of directory list, so ill-formed table
1670 for J
in 0 .. Match
.File
loop
1671 for K
in 1 .. Integer (C
.Header
.File_Name_Entry_Format_Count
)
1673 if File_Entry_Format
(K
).C_Type
= DW_LNCT_path
then
1674 case File_Entry_Format
(K
).Form
is
1675 when DW_FORM_string
=>
1676 File_Name
:= Read_C_String
(C
.Lines
);
1678 when DW_FORM_line_strp
=>
1679 Read_Section_Offset
(C
.Lines
, Off
, C
.Header
.Is64
);
1680 if J
= Match
.File
then
1681 Seek
(C
.Line_Str
, Off
);
1682 File_Name
:= Read_C_String
(C
.Line_Str
);
1686 raise Dwarf_Error
with "DWARF form not implemented";
1689 elsif File_Entry_Format
(K
).C_Type
= DW_LNCT_directory_index
1691 case File_Entry_Format
(K
).Form
is
1692 when DW_FORM_data1
=>
1693 Dir_Idx
:= uint32
(uint8
'(Read (C.Lines)));
1695 when DW_FORM_data2 =>
1696 Dir_Idx := uint32 (uint16'(Read
(C
.Lines
)));
1698 when DW_FORM_udata
=>
1699 Dir_Idx
:= Read_LEB128
(C
.Lines
);
1702 raise Dwarf_Error
with
1703 "invalid DWARF form for DW_LNCT_directory_index";
1708 File_Entry_Format
(K
).Form
,
1710 C
.Header
.Address_Size
);
1715 Seek
(C
.Lines
, C
.Header
.Directories
);
1717 for J
in 0 .. Dir_Idx
loop
1718 for K
in 1 .. Integer (C
.Header
.Directory_Entry_Format_Count
)
1720 if Directory_Entry_Format
(K
).C_Type
= DW_LNCT_path
then
1721 case Directory_Entry_Format
(K
).Form
is
1722 when DW_FORM_string
=>
1723 Dir_Name
:= Read_C_String
(C
.Lines
);
1725 when DW_FORM_line_strp
=>
1726 Read_Section_Offset
(C
.Lines
, Off
, C
.Header
.Is64
);
1728 Seek
(C
.Line_Str
, Off
);
1729 Dir_Name
:= Read_C_String
(C
.Line_Str
);
1733 raise Dwarf_Error
with "DWARF form not implemented";
1738 Directory_Entry_Format
(K
).Form
,
1740 C
.Header
.Address_Size
);
1746 Line_Num
:= Natural (Match
.Line
);
1749 Addr_Int
: constant uint64
:= uint64
(Addr
);
1750 Previous_Row
: Line_Info_Registers
;
1751 Info_Offset
: Offset
;
1752 Line_Offset
: Offset
;
1758 -- Initialize result
1762 Subprg_Name
:= (null, 0);
1765 -- Look up the symbol in the cache
1767 if C
.Cache
/= null then
1769 Off
: constant uint32
:= uint32
'(Addr - C.Low);
1771 First, Last, Mid : Natural;
1773 First := C.Cache'First;
1774 Last := C.Cache'Last;
1777 while First <= Last loop
1778 Mid := First + (Last - First) / 2;
1779 if Off < C.Cache (Mid).First then
1781 elsif Off >= C.Cache (Mid).First + C.Cache (Mid).Size then
1788 if Off >= C.Cache (Mid).First
1789 and then Off < C.Cache (Mid).First + C.Cache (Mid).Size
1791 Line_Offset := Offset (C.Cache (Mid).Line);
1792 S := Read_Symbol (C.Obj.all, Offset (C.Cache (Mid).Sym));
1793 Subprg_Name := Object_Reader.Name (C.Obj.all, S);
1799 -- Search for the symbol in the binary
1802 S := First_Symbol (C.Obj.all);
1803 while S /= Null_Symbol loop
1804 if Spans (S, Addr_Int) then
1805 Subprg_Name := Object_Reader.Name (C.Obj.all, S);
1809 S := Next_Symbol (C.Obj.all, S);
1812 -- Search address in aranges table
1814 Aranges_Lookup (C, Addr, Info_Offset, Success);
1819 -- Search stmt_list in info table
1821 Debug_Info_Lookup (C, Info_Offset, Line_Offset, Success);
1827 Seek (C.Lines, Line_Offset);
1829 Initialize_State_Machine (C);
1831 Previous_Row.Line := 0;
1833 -- Advance to the first entry
1836 Read_And_Execute_Insn (C, Done);
1838 if C.Registers.Is_Row then
1839 Previous_Row := C.Registers;
1846 -- Read the rest of the entries
1848 while Tell (C.Lines) < C.Next_Header loop
1849 Read_And_Execute_Insn (C, Done);
1851 if C.Registers.Is_Row then
1852 if not Previous_Row.End_Sequence
1853 and then Addr_Int >= Previous_Row.Address
1854 and then Addr_Int < C.Registers.Address
1856 Set_Result (Previous_Row);
1859 elsif Addr_Int = C.Registers.Address then
1860 Set_Result (C.Registers);
1864 Previous_Row := C.Registers;
1869 end Symbolic_Address;
1875 function String_Length (Str : Str_Access) return Natural is
1877 for I in Str'Range loop
1878 if Str (I) = ASCII.NUL then
1879 return I - Str'First;
1886 ------------------------
1887 -- Symbolic_Traceback --
1888 ------------------------
1890 procedure Symbolic_Traceback
1891 (Cin : Dwarf_Context;
1892 Traceback : STE.Tracebacks_Array;
1893 Suppress_Hex : Boolean;
1894 Symbol_Found : out Boolean;
1895 Res : in out System.Bounded_Strings.Bounded_String)
1897 use Ada.Characters.Handling;
1898 C : Dwarf_Context := Cin;
1900 Addr_In_Traceback : Address;
1902 Dir_Name : Str_Access;
1903 File_Name : Str_Access;
1904 Subprg_Name : String_Ptr_Len;
1909 if not C.Has_Debug then
1910 Symbol_Found := False;
1913 Symbol_Found := True;
1916 for J in Traceback'Range loop
1917 -- If the buffer is full, no need to do any useless work
1918 exit when Is_Full (Res);
1920 Addr_In_Traceback := STE.PC_For (Traceback (J));
1924 Addr_In_Traceback - Get_Load_Displacement (C),
1930 -- If we're not requested to suppress hex addresses, emit it now.
1932 if not Suppress_Hex then
1933 Append_Address (Res, Addr_In_Traceback);
1937 if File_Name /= null then
1939 Last : constant Natural := String_Length (File_Name);
1940 Is_Ada : constant Boolean :=
1943 To_Upper (String (File_Name (Last - 3 .. Last - 1))) =
1945 -- True if this is an Ada file. This doesn't take into account
1946 -- nonstandard file-naming conventions, but that's OK; this is
1947 -- purely cosmetic. It covers at least .ads, .adb, and .ada.
1949 Line_Image : constant String := Natural'Image (Line_Num);
1951 if Subprg_Name.Len /= 0 then
1952 -- For Ada code, Symbol_Image is in all lower case; we don't
1953 -- have the case from the original source code. But the best
1954 -- guess is Mixed_Case, so convert to that.
1958 Symbol_Image : String :=
1959 Object_Reader.Decoded_Ada_Name
1963 for K in Symbol_Image'Range loop
1964 if K = Symbol_Image'First
1966 (Is_Letter (Symbol_Image (K - 1))
1967 or else Is_Digit (Symbol_Image (K - 1)))
1969 Symbol_Image (K) := To_Upper (Symbol_Image (K));
1972 Append (Res, Symbol_Image);
1975 Off := Strip_Leading_Char (C.Obj.all, Subprg_Name);
1979 String (Subprg_Name.Ptr (Off .. Subprg_Name.Len)));
1982 Append (Res, "???");
1985 Append (Res, " at ");
1986 Append (Res, String (File_Name (1 .. Last)));
1988 Append (Res, Line_Image (2 .. Line_Image'Last));
1991 if Subprg_Name.Len > 0 then
1992 Off := Strip_Leading_Char (C.Obj.all, Subprg_Name);
1994 Append (Res, String (Subprg_Name.Ptr (Off .. Subprg_Name.Len)));
1996 Append (Res, "???");
1999 Append (Res, " at ???");
2002 Append (Res, ASCII.LF);
2004 end Symbolic_Traceback;
2006 end System.Dwarf_Lines;