summaryrefslogtreecommitdiff
path: root/src/ortho/mcode
diff options
context:
space:
mode:
authorTristan Gingold2015-11-18 21:45:45 +0100
committerTristan Gingold2015-11-19 05:47:59 +0100
commit92b0b82ea32982b94eb8bf19a0b498d92053fffe (patch)
tree70b04f103d145dc01d31870e50b5e6a654dc20e0 /src/ortho/mcode
parentff4bc5fb13a997a1d00596578b6d7deb5c0b0da6 (diff)
downloadghdl-92b0b82ea32982b94eb8bf19a0b498d92053fffe.tar.gz
ghdl-92b0b82ea32982b94eb8bf19a0b498d92053fffe.tar.bz2
ghdl-92b0b82ea32982b94eb8bf19a0b498d92053fffe.zip
Add symbolizer (for mcode).
Display a backtrace in case of failed check or assert failure.
Diffstat (limited to 'src/ortho/mcode')
-rw-r--r--src/ortho/mcode/binary_file-format.ads20
-rw-r--r--src/ortho/mcode/binary_file-memory.adb26
-rw-r--r--src/ortho/mcode/binary_file-memory.ads11
-rw-r--r--src/ortho/mcode/dwarf.ads3
-rw-r--r--src/ortho/mcode/ortho_code-dwarf.adb174
-rw-r--r--src/ortho/mcode/ortho_code-dwarf.ads8
-rw-r--r--src/ortho/mcode/ortho_code-flags.ads4
-rw-r--r--src/ortho/mcode/ortho_code-x86-abi.adb9
-rw-r--r--src/ortho/mcode/ortho_code-x86-emits.adb8
-rw-r--r--src/ortho/mcode/ortho_code_main.adb5
-rw-r--r--src/ortho/mcode/ortho_jit.adb52
-rw-r--r--src/ortho/mcode/symbolizer.adb655
-rw-r--r--src/ortho/mcode/symbolizer.ads48
13 files changed, 910 insertions, 113 deletions
diff --git a/src/ortho/mcode/binary_file-format.ads b/src/ortho/mcode/binary_file-format.ads
new file mode 100644
index 0000000..57a65b7
--- /dev/null
+++ b/src/ortho/mcode/binary_file-format.ads
@@ -0,0 +1,20 @@
+-- Binary file writer.
+-- Copyright (C) 2015 Tristan Gingold
+--
+-- GHDL is free software; you can redistribute it and/or modify it under
+-- the terms of the GNU General Public License as published by the Free
+-- Software Foundation; either version 2, or (at your option) any later
+-- version.
+--
+-- GHDL is distributed in the hope that it will be useful, but WITHOUT 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
+-- along with GCC; see the file COPYING. If not, write to the Free
+-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+-- 02111-1307, USA.
+with Binary_File.Elf;
+
+package Binary_File.Format renames Binary_File.Elf;
diff --git a/src/ortho/mcode/binary_file-memory.adb b/src/ortho/mcode/binary_file-memory.adb
index a37af9c..9797cd6 100644
--- a/src/ortho/mcode/binary_file-memory.adb
+++ b/src/ortho/mcode/binary_file-memory.adb
@@ -16,17 +16,12 @@
-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-- 02111-1307, USA.
with Ada.Text_IO; use Ada.Text_IO;
-with Ada.Unchecked_Conversion;
package body Binary_File.Memory is
-- Absolute section.
Sect_Abs : Section_Acc;
- function To_Pc_Type is new Ada.Unchecked_Conversion
- (Source => System.Address, Target => Pc_Type);
-
- procedure Set_Symbol_Address (Sym : Symbol; Addr : System.Address)
- is
+ procedure Set_Symbol_Address (Sym : Symbol; Addr : System.Address) is
begin
Set_Symbol_Value (Sym, To_Pc_Type (Addr));
Set_Scope (Sym, Sym_Global);
@@ -48,20 +43,21 @@ package body Binary_File.Memory is
-- Relocate section in memory.
Sect := Section_Chain;
while Sect /= null loop
+ -- Allocate memory if needed (eg: .bss)
if Sect.Data = null then
if Sect.Pc > 0 then
Resize (Sect, Sect.Pc);
Sect.Data (0 .. Sect.Pc - 1) := (others => 0);
- else
- null;
- --Sect.Data := new Byte_Array (1 .. 0);
end if;
end if;
- if Sect.Data_Max > 0
+
+ -- Set virtual address.
+ if Sect.Pc > 0
and (Sect /= Sect_Abs and Sect.Flags /= Section_Debug)
then
Sect.Vaddr := To_Pc_Type (Sect.Data (0)'Address);
end if;
+
Sect := Sect.Next;
end loop;
@@ -98,4 +94,14 @@ package body Binary_File.Memory is
Sect := Sect.Next;
end loop;
end Write_Memory_Relocate;
+
+ function Get_Section_Base (Sect : Section_Acc) return System.Address is
+ begin
+ return Sect.Data (0)'Address;
+ end Get_Section_Base;
+
+ function Get_Section_Size (Sect : Section_Acc) return Pc_Type is
+ begin
+ return Sect.Pc;
+ end Get_Section_Size;
end Binary_File.Memory;
diff --git a/src/ortho/mcode/binary_file-memory.ads b/src/ortho/mcode/binary_file-memory.ads
index a205da5..cc2b7e3 100644
--- a/src/ortho/mcode/binary_file-memory.ads
+++ b/src/ortho/mcode/binary_file-memory.ads
@@ -15,6 +15,8 @@
-- along with GCC; see the file COPYING. If not, write to the Free
-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-- 02111-1307, USA.
+with Ada.Unchecked_Conversion;
+
package Binary_File.Memory is
-- Must be called before set_symbol_address.
@@ -22,4 +24,13 @@ package Binary_File.Memory is
procedure Set_Symbol_Address (Sym : Symbol; Addr : System.Address);
procedure Write_Memory_Relocate (Error : out Boolean);
+
+ function Get_Section_Base (Sect : Section_Acc) return System.Address;
+ function Get_Section_Size (Sect : Section_Acc) return Pc_Type;
+
+ function To_Pc_Type is new Ada.Unchecked_Conversion
+ (Source => System.Address, Target => Pc_Type);
+ function To_Address is new Ada.Unchecked_Conversion
+ (Source => Pc_Type, Target => System.Address);
+
end Binary_File.Memory;
diff --git a/src/ortho/mcode/dwarf.ads b/src/ortho/mcode/dwarf.ads
index 40ee94f..8a3058c 100644
--- a/src/ortho/mcode/dwarf.ads
+++ b/src/ortho/mcode/dwarf.ads
@@ -396,6 +396,7 @@ package Dwarf is
DW_LNS_Set_Isa : constant Unsigned_8 := 12;
-- Line number extended opcode.
+ -- Encoding is 0:Len:LNE_OP:data
DW_LNE_End_Sequence : constant Unsigned_8 := 1;
DW_LNE_Set_Address : constant Unsigned_8 := 2;
DW_LNE_Define_File : constant Unsigned_8 := 3;
@@ -442,5 +443,3 @@ package Dwarf is
DW_EH_PE_Datarel : constant Unsigned_8 := 16#30#;
DW_EH_PE_Format_Mask : constant Unsigned_8 := 16#0f#;
end Dwarf;
-
-
diff --git a/src/ortho/mcode/ortho_code-dwarf.adb b/src/ortho/mcode/ortho_code-dwarf.adb
index 309c82d..521ab85 100644
--- a/src/ortho/mcode/ortho_code-dwarf.adb
+++ b/src/ortho/mcode/ortho_code-dwarf.adb
@@ -18,13 +18,12 @@
with GNAT.Directory_Operations;
with Tables;
with Interfaces; use Interfaces;
-with Binary_File; use Binary_File;
with Dwarf; use Dwarf;
with Ada.Text_IO;
+with Ortho_Code.Flags; use Ortho_Code.Flags;
with Ortho_Code.Decls;
with Ortho_Code.Types;
with Ortho_Code.Consts;
-with Ortho_Code.Flags;
with Ortho_Ident;
with Ortho_Code.Binary;
@@ -52,21 +51,8 @@ package body Ortho_Code.Dwarf is
Info_Sym : Symbol;
Line_Sym : Symbol;
- Line_Sect : Section_Acc;
- Abbrev_Sect : Section_Acc;
- Info_Sect : Section_Acc;
- Aranges_Sect : Section_Acc;
-
Abbrev_Last : Unsigned_32;
--- procedure Gen_String (Str : String)
--- is
--- begin
--- for I in Str'Range loop
--- Gen_B8 (Character'Pos (Str (I)));
--- end loop;
--- end Gen_String;
-
procedure Gen_String_Nul (Str : String)
is
begin
@@ -118,12 +104,6 @@ package body Ortho_Code.Dwarf is
end loop;
end Gen_Uleb128;
--- procedure New_Debug_Line_Decl (Line : Int32)
--- is
--- begin
--- Line_Last := Line;
--- end New_Debug_Line_Decl;
-
procedure Set_Line_Stmt (Line : Int32)
is
Pc : Pc_Type;
@@ -154,6 +134,7 @@ package body Ortho_Code.Dwarf is
Gen_Uleb128 (Unsigned_32 (Cur_File));
Last_File := Cur_File;
elsif Cur_File = 0 then
+ -- No file yet.
return;
end if;
@@ -173,7 +154,6 @@ package body Ortho_Code.Dwarf is
+ Byte (D_Pc) * Line_Range
+ Byte (D_Ln - Line_Base));
- --Set_Current_Section (Text_Sect);
Line_Pc := Pc;
Line_Last := Line;
end Set_Line_Stmt;
@@ -269,13 +249,11 @@ package body Ortho_Code.Dwarf is
Gen_Uleb128 (Form);
end Gen_Abbrev_Tuple;
- procedure Init
- is
+ procedure Init is
begin
-- Generate type names.
Flags.Flag_Type_Name := True;
-
Orig_Sym := Create_Local_Symbol;
Set_Symbol_Pc (Orig_Sym, False);
End_Sym := Create_Local_Symbol;
@@ -533,10 +511,9 @@ package body Ortho_Code.Dwarf is
is
Off : Pc_Type;
begin
+ pragma Assert (Flag_Debug >= Debug_Dwarf);
Off := TOnodes.Table (Atype);
- if Off = Null_Pc then
- raise Program_Error;
- end if;
+ pragma Assert (Off /= Null_Pc);
Gen_32 (Unsigned_32 (Off));
end Emit_Type_Ref;
@@ -979,6 +956,10 @@ package body Ortho_Code.Dwarf is
Kind : OT_Kind;
Decl : O_Dnode;
begin
+ if Flag_Debug < Debug_Dwarf then
+ return;
+ end if;
+
-- If already emitted, then return.
if Atype <= TOnodes.Last
and then TOnodes.Table (Atype) /= Null_Pc
@@ -1160,21 +1141,23 @@ package body Ortho_Code.Dwarf is
Sdecl : O_Dnode;
Sibling_Pc : Pc_Type;
begin
- if Abbrev_Block = 0 then
- Generate_Abbrev (Abbrev_Block);
+ if Flag_Debug >= Debug_Dwarf then
+ if Abbrev_Block = 0 then
+ Generate_Abbrev (Abbrev_Block);
- Gen_Abbrev_Header (DW_TAG_Lexical_Block, DW_CHILDREN_Yes);
- Gen_Abbrev_Tuple (DW_AT_Sibling, DW_FORM_Ref4);
- Gen_Abbrev_Tuple (DW_AT_Low_Pc, DW_FORM_Addr);
- Gen_Abbrev_Tuple (DW_AT_High_Pc, DW_FORM_Addr);
- Gen_Abbrev_Tuple (0, 0);
- end if;
+ Gen_Abbrev_Header (DW_TAG_Lexical_Block, DW_CHILDREN_Yes);
+ Gen_Abbrev_Tuple (DW_AT_Sibling, DW_FORM_Ref4);
+ Gen_Abbrev_Tuple (DW_AT_Low_Pc, DW_FORM_Addr);
+ Gen_Abbrev_Tuple (DW_AT_High_Pc, DW_FORM_Addr);
+ Gen_Abbrev_Tuple (0, 0);
+ end if;
- Gen_Info_Header (Abbrev_Block);
- Sibling_Pc := Gen_Info_Sibling;
+ Gen_Info_Header (Abbrev_Block);
+ Sibling_Pc := Gen_Info_Sibling;
- Gen_Ua_32 (Subprg_Sym, Integer_32 (Get_Block_Info1 (Decl)));
- Gen_Ua_32 (Subprg_Sym, Integer_32 (Get_Block_Info2 (Decl)));
+ Gen_Ua_32 (Subprg_Sym, Integer_32 (Get_Block_Info1 (Decl)));
+ Gen_Ua_32 (Subprg_Sym, Integer_32 (Get_Block_Info2 (Decl)));
+ end if;
-- Emit decls for children.
Last := Get_Block_Last (Decl);
@@ -1184,11 +1167,13 @@ package body Ortho_Code.Dwarf is
Sdecl := Get_Decl_Chain (Sdecl);
end loop;
- -- End of children.
- Set_Current_Section (Info_Sect);
- Gen_Uleb128 (0);
+ if Flag_Debug >= Debug_Dwarf then
+ -- End of children.
+ Set_Current_Section (Info_Sect);
+ Gen_Uleb128 (0);
- Patch_Info_Sibling (Sibling_Pc);
+ Patch_Info_Sibling (Sibling_Pc);
+ end if;
end Emit_Block_Decl;
Abbrev_Function : Unsigned_32 := 0;
@@ -1198,15 +1183,12 @@ package body Ortho_Code.Dwarf is
procedure Emit_Subprg_Body (Bod : O_Dnode)
is
use Ortho_Code.Decls;
- Kind : OD_Kind;
- Decl : O_Dnode;
+ Decl : constant O_Dnode := Get_Body_Decl (Bod);
+ Kind : constant OD_Kind := Get_Decl_Kind (Decl);
Idecl : O_Dnode;
Prev_Subprg_Sym : Symbol;
Sibling_Pc : Pc_Type;
begin
- Decl := Get_Body_Decl (Bod);
- Kind := Get_Decl_Kind (Decl);
-
-- Emit interfaces type.
Idecl := Get_Subprg_Interfaces (Decl);
while Idecl /= O_Dnode_Null loop
@@ -1220,13 +1202,15 @@ package body Ortho_Code.Dwarf is
Generate_Abbrev (Abbrev_Function);
Gen_Abbrev_Header (DW_TAG_Subprogram, DW_CHILDREN_Yes);
- Gen_Abbrev_Tuple (DW_AT_Sibling, DW_FORM_Ref4);
-
- Gen_Abbrev_Tuple (DW_AT_Type, DW_FORM_Ref4);
Gen_Abbrev_Tuple (DW_AT_Name, DW_FORM_String);
Gen_Abbrev_Tuple (DW_AT_Low_Pc, DW_FORM_Addr);
Gen_Abbrev_Tuple (DW_AT_High_Pc, DW_FORM_Addr);
- Gen_Abbrev_Tuple (DW_AT_Frame_Base, DW_FORM_Block1);
+
+ if Flag_Debug >= Debug_Dwarf then
+ Gen_Abbrev_Tuple (DW_AT_Type, DW_FORM_Ref4);
+ Gen_Abbrev_Tuple (DW_AT_Sibling, DW_FORM_Ref4);
+ Gen_Abbrev_Tuple (DW_AT_Frame_Base, DW_FORM_Block1);
+ end if;
--Gen_Abbrev_Tuple (DW_AT_Return_Addr, DW_FORM_Block1);
Gen_Abbrev_Tuple (0, 0);
end if;
@@ -1236,37 +1220,48 @@ package body Ortho_Code.Dwarf is
Generate_Abbrev (Abbrev_Procedure);
Gen_Abbrev_Header (DW_TAG_Subprogram, DW_CHILDREN_Yes);
- Gen_Abbrev_Tuple (DW_AT_Sibling, DW_FORM_Ref4);
Gen_Abbrev_Tuple (DW_AT_Name, DW_FORM_String);
Gen_Abbrev_Tuple (DW_AT_Low_Pc, DW_FORM_Addr);
Gen_Abbrev_Tuple (DW_AT_High_Pc, DW_FORM_Addr);
- Gen_Abbrev_Tuple (DW_AT_Frame_Base, DW_FORM_Block1);
+ if Flag_Debug >= Debug_Dwarf then
+ Gen_Abbrev_Tuple (DW_AT_Sibling, DW_FORM_Ref4);
+ Gen_Abbrev_Tuple (DW_AT_Frame_Base, DW_FORM_Block1);
+ end if;
--Gen_Abbrev_Tuple (DW_AT_Return_Addr, DW_FORM_Block1);
Gen_Abbrev_Tuple (0, 0);
end if;
Gen_Info_Header (Abbrev_Procedure);
end if;
- Sibling_Pc := Gen_Info_Sibling;
-
- if Kind = OD_Function then
- Emit_Decl_Type (Decl);
- end if;
-
+ -- Name.
Emit_Decl_Ident (Decl);
+
+ -- Low, High.
Prev_Subprg_Sym := Subprg_Sym;
Subprg_Sym := Binary.Get_Decl_Symbol (Decl);
Gen_Ua_32 (Subprg_Sym, 0);
Gen_Ua_32 (Subprg_Sym, Integer_32 (Get_Body_Info (Bod)));
- -- Frame base.
- Gen_B8 (1);
- Gen_B8 (DW_OP_Reg5);
+ if Flag_Debug >= Debug_Dwarf then
+ -- Type.
+ if Kind = OD_Function then
+ Emit_Decl_Type (Decl);
+ end if;
+
+ -- Sibling.
+ Sibling_Pc := Gen_Info_Sibling;
+
+ -- Frame base.
+ Gen_B8 (1);
+ Gen_B8 (DW_OP_Reg5);
+ end if;
-- Interfaces.
Idecl := Get_Subprg_Interfaces (Decl);
- if Idecl /= O_Dnode_Null then
+ if Idecl /= O_Dnode_Null
+ and then Flag_Debug >= Debug_Dwarf
+ then
if Abbrev_Interface = 0 then
Generate_Abbrev (Abbrev_Interface);
@@ -1295,7 +1290,9 @@ package body Ortho_Code.Dwarf is
-- End of children.
Gen_Uleb128 (0);
- Patch_Info_Sibling (Sibling_Pc);
+ if Flag_Debug >= Debug_Dwarf then
+ Patch_Info_Sibling (Sibling_Pc);
+ end if;
Subprg_Sym := Prev_Subprg_Sym;
end Emit_Subprg_Body;
@@ -1305,26 +1302,32 @@ package body Ortho_Code.Dwarf is
use Ada.Text_IO;
use Ortho_Code.Decls;
begin
- case Get_Decl_Kind (Decl) is
- when OD_Type =>
- Emit_Type_Decl (Decl);
- when OD_Local
- | OD_Var =>
- Emit_Variable (Decl);
- when OD_Const =>
- Emit_Const (Decl);
- when OD_Function
- | OD_Procedure
- | OD_Interface =>
- null;
- when OD_Body =>
+ if Flag_Debug = Debug_Dwarf then
+ case Get_Decl_Kind (Decl) is
+ when OD_Type =>
+ Emit_Type_Decl (Decl);
+ when OD_Local
+ | OD_Var =>
+ Emit_Variable (Decl);
+ when OD_Const =>
+ Emit_Const (Decl);
+ when OD_Function
+ | OD_Procedure
+ | OD_Interface =>
+ null;
+ when OD_Body =>
+ Emit_Subprg_Body (Decl);
+ when OD_Block =>
+ Emit_Block_Decl (Decl);
+ when others =>
+ Put_Line ("dwarf.emit_decl: emit "
+ & OD_Kind'Image (Get_Decl_Kind (Decl)));
+ end case;
+ elsif Flag_Debug = Debug_Line then
+ if Get_Decl_Kind (Decl) = OD_Body then
Emit_Subprg_Body (Decl);
- when OD_Block =>
- Emit_Block_Decl (Decl);
- when others =>
- Put_Line ("dwarf.emit_decl: emit "
- & OD_Kind'Image (Get_Decl_Kind (Decl)));
- end case;
+ end if;
+ end if;
end Emit_Decl;
procedure Emit_Subprg (Bod : O_Dnode) is
@@ -1347,4 +1350,3 @@ package body Ortho_Code.Dwarf is
end Release;
end Ortho_Code.Dwarf;
-
diff --git a/src/ortho/mcode/ortho_code-dwarf.ads b/src/ortho/mcode/ortho_code-dwarf.ads
index c120bcf..095a80d 100644
--- a/src/ortho/mcode/ortho_code-dwarf.ads
+++ b/src/ortho/mcode/ortho_code-dwarf.ads
@@ -15,6 +15,8 @@
-- along with GCC; see the file COPYING. If not, write to the Free
-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-- 02111-1307, USA.
+with Binary_File; use Binary_File;
+
package Ortho_Code.Dwarf is
procedure Init;
procedure Finish;
@@ -33,6 +35,12 @@ package Ortho_Code.Dwarf is
procedure Mark (M : out Mark_Type);
procedure Release (M : Mark_Type);
+ -- Sections created by dwarf.
+ Line_Sect : Section_Acc;
+ Abbrev_Sect : Section_Acc;
+ Info_Sect : Section_Acc;
+ Aranges_Sect : Section_Acc;
+
private
type Mark_Type is record
Last_Decl : O_Dnode;
diff --git a/src/ortho/mcode/ortho_code-flags.ads b/src/ortho/mcode/ortho_code-flags.ads
index 214cc74..30bded9 100644
--- a/src/ortho/mcode/ortho_code-flags.ads
+++ b/src/ortho/mcode/ortho_code-flags.ads
@@ -16,10 +16,10 @@
-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-- 02111-1307, USA.
package Ortho_Code.Flags is
- type Debug_Type is (Debug_None, Debug_Dwarf);
+ type Debug_Type is (Debug_None, Debug_Line, Debug_Dwarf);
-- Debugging information generated.
- Flag_Debug : Debug_Type := Debug_None;
+ Flag_Debug : Debug_Type := Debug_Line;
-- If set, generate a map from type to type declaration.
-- Set with --be-debug=t
diff --git a/src/ortho/mcode/ortho_code-x86-abi.adb b/src/ortho/mcode/ortho_code-x86-abi.adb
index 2be10fe..0a44339 100644
--- a/src/ortho/mcode/ortho_code-x86-abi.adb
+++ b/src/ortho/mcode/ortho_code-x86-abi.adb
@@ -115,7 +115,7 @@ package body Ortho_Code.X86.Abi is
Emits.Emit_Subprg (Subprg);
if Get_Decl_Depth (Subprg.D_Decl) = O_Toplevel
- and then Flag_Debug = Debug_Dwarf
+ and then Flag_Debug /= Debug_None
then
Dwarf.Emit_Decls_Until (Subprg.D_Body);
if not Debug.Flag_Debug_Keep then
@@ -133,7 +133,8 @@ package body Ortho_Code.X86.Abi is
Cur_Subprg := Subprg;
if Get_Decl_Depth (Subprg.D_Decl) = O_Toplevel then
- if Flag_Debug = Debug_Dwarf then
+ -- Only for top-level subprograms.
+ if Flag_Debug /= Debug_None then
Dwarf.Emit_Subprg (Subprg.D_Body);
end if;
@@ -142,7 +143,7 @@ package body Ortho_Code.X86.Abi is
Release (Decls_Mark);
Consts.Release (Consts_Mark);
Release (Types_Mark);
- if Flag_Debug = Debug_Dwarf then
+ if Flag_Debug /= Debug_None then
Dwarf.Release (Dwarf_Mark);
end if;
end if;
@@ -607,7 +608,7 @@ package body Ortho_Code.X86.Abi is
is
use Ortho_Code.Flags;
begin
- if Flag_Debug = Debug_Dwarf then
+ if Flag_Debug /= Debug_None then
Dwarf.Set_Filename ("", Filename);
end if;
end New_Debug_Filename_Decl;
diff --git a/src/ortho/mcode/ortho_code-x86-emits.adb b/src/ortho/mcode/ortho_code-x86-emits.adb
index 4120801..c4cfee9 100644
--- a/src/ortho/mcode/ortho_code-x86-emits.adb
+++ b/src/ortho/mcode/ortho_code-x86-emits.adb
@@ -2356,7 +2356,7 @@ package body Ortho_Code.X86.Emits is
null;
when OE_Line =>
- if Flag_Debug = Debug_Dwarf then
+ if Flag_Debug /= Debug_None then
Dwarf.Set_Line_Stmt (Get_Expr_Line_Number (Stmt));
Set_Current_Section (Sect_Text);
end if;
@@ -2516,7 +2516,7 @@ package body Ortho_Code.X86.Emits is
Gen_1 (Opc_Leave);
Gen_1 (Opc_Ret);
- if Flag_Debug = Debug_Dwarf then
+ if Flag_Debug /= Debug_None then
Set_Body_Info (Subprg.D_Body, Int32 (Get_Current_Pc - Subprg_Pc));
end if;
end Emit_Epilogue;
@@ -2704,7 +2704,7 @@ package body Ortho_Code.X86.Emits is
Debug_Hex := True;
end if;
- if Flag_Debug = Debug_Dwarf then
+ if Flag_Debug /= Debug_None then
Dwarf.Init;
Set_Current_Section (Sect_Text);
end if;
@@ -2714,7 +2714,7 @@ package body Ortho_Code.X86.Emits is
is
use Ortho_Code.Flags;
begin
- if Flag_Debug = Debug_Dwarf then
+ if Flag_Debug /= Debug_None then
Set_Current_Section (Sect_Text);
Dwarf.Finish;
end if;
diff --git a/src/ortho/mcode/ortho_code_main.adb b/src/ortho/mcode/ortho_code_main.adb
index c515f58..b3a2e19 100644
--- a/src/ortho/mcode/ortho_code_main.adb
+++ b/src/ortho/mcode/ortho_code_main.adb
@@ -83,6 +83,9 @@ begin
elsif Arg = "-g" then
Flag_Debug := Debug_Dwarf;
I := I + 1;
+ elsif Arg = "-g0" then
+ Flag_Debug := Debug_None;
+ I := I + 1;
elsif Arg = "-p" or Arg = "-pg" then
Flag_Profile := True;
I := I + 1;
@@ -194,5 +197,3 @@ exception
Set_Exit_Status (2);
raise;
end Ortho_Code_Main;
-
-
diff --git a/src/ortho/mcode/ortho_jit.adb b/src/ortho/mcode/ortho_jit.adb
index 907aea0..f01c8fa 100644
--- a/src/ortho/mcode/ortho_jit.adb
+++ b/src/ortho/mcode/ortho_jit.adb
@@ -1,5 +1,5 @@
-- Ortho JIT implementation for mcode.
--- Copyright (C) 2009 Tristan Gingold
+-- Copyright (C) 2009 - 2015 Tristan Gingold
--
-- GHDL is free software; you can redistribute it and/or modify it under
-- the terms of the GNU General Public License as published by the Free
@@ -16,6 +16,8 @@
-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-- 02111-1307, USA.
+with System.Storage_Elements; use System.Storage_Elements;
+
with GNAT.OS_Lib; use GNAT.OS_Lib;
with Ada.Text_IO;
@@ -26,7 +28,9 @@ with Ortho_Mcode.Jit;
with Ortho_Code.Flags; use Ortho_Code.Flags;
with Ortho_Code.Debug;
with Ortho_Code.Abi;
-with Binary_File.Elf;
+with Ortho_Code.Dwarf;
+with Binary_File.Format;
+with Symbolizer;
package body Ortho_Jit is
Snap_Filename : GNAT.OS_Lib.String_Access := null;
@@ -76,7 +80,7 @@ package body Ortho_Jit is
Status := False;
return;
else
- Binary_File.Elf.Write (Fd);
+ Binary_File.Format.Write (Fd);
Close (Fd);
end if;
end;
@@ -98,6 +102,9 @@ package body Ortho_Jit is
if Opt = "-g" then
Flag_Debug := Debug_Dwarf;
return True;
+ elsif Opt = "-g0" then
+ Flag_Debug := Debug_None;
+ return True;
elsif Opt'Length > 5 and then Opt (1 .. 5) = "--be-" then
Ortho_Code.Debug.Set_Be_Flag (Opt);
return True;
@@ -122,4 +129,43 @@ package body Ortho_Jit is
return "mcode";
end Get_Jit_Name;
+ procedure Symbolize (Pc : Address;
+ Filename : out Address;
+ Lineno : out Natural;
+ Subprg : out Address)
+ is
+ use Binary_File.Memory;
+ use Symbolizer;
+
+ function Get_Section_Content (Sect : Section_Acc) return Section_Content
+ is
+ Addr : Address;
+ Size : Pc_Type;
+ begin
+ if Sect = null then
+ return (Null_Address, 0);
+ else
+ Addr := Get_Section_Base (Sect);
+ Size := Get_Section_Size (Sect);
+ return (Addr, Storage_Offset (Size));
+ end if;
+ end Get_Section_Content;
+
+ Sections : Dwarf_Sections;
+ Res : Symbolize_Result;
+ begin
+ Sections.Debug_Line :=
+ Get_Section_Content (Ortho_Code.Dwarf.Line_Sect);
+ Sections.Debug_Info :=
+ Get_Section_Content (Ortho_Code.Dwarf.Info_Sect);
+ Sections.Debug_Abbrev :=
+ Get_Section_Content (Ortho_Code.Dwarf.Abbrev_Sect);
+
+ Symbolize_Address (Pc, Sections, Res);
+
+ Filename := Res.Filename;
+ Lineno := Res.Line;
+ Subprg := Res.Subprg_Name;
+ end Symbolize;
+
end Ortho_Jit;
diff --git a/src/ortho/mcode/symbolizer.adb b/src/ortho/mcode/symbolizer.adb
new file mode 100644
index 0000000..79e7de2
--- /dev/null
+++ b/src/ortho/mcode/symbolizer.adb
@@ -0,0 +1,655 @@
+-- Dwarf symbolizer.
+-- Copyright (C) 2015 Tristan Gingold
+--
+-- GHDL is free software; you can redistribute it and/or modify it under
+-- the terms of the GNU General Public License as published by the Free
+-- Software Foundation; either version 2, or (at your option) any later
+-- version.
+--
+-- GHDL is distributed in the hope that it will be useful, but WITHOUT 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
+-- along with GCC; see the file COPYING. If not, write to the Free
+-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+-- 02111-1307, USA.
+
+with Ada.Unchecked_Conversion;
+with Interfaces; use Interfaces;
+with Dwarf; use Dwarf;
+
+package body Symbolizer is
+ type Abbrev_Array is array (Unsigned_32 range <>) of Address;
+ type Abbrev_Array_Acc is access Abbrev_Array;
+
+ -- Data for decoding abbrevs.
+ -- Abbrevs are referenced by its number, but it is not possible to directly
+ -- reference an abbrev from its number. A map is required.
+ -- The main purpose of these data is to build the map.
+ type Abbrev_Data is record
+ -- Static map. Mcode doesn't generate a lot of abbrev.
+ Sarray : Abbrev_Array (1 .. 64);
+ -- First non-decoded abbrev.
+ Next_Num : Unsigned_32;
+ -- Address (in .debug_abbrev section) of the next abbrev to be decoded.
+ Next_Addr : Address;
+ -- Address of the first byte after the abbrev section. Used to not read
+ -- past the section.
+ Last_Addr : Address;
+ -- If there are too many abbrevs, use a resizable array instead of the
+ -- static one.
+ Map : Abbrev_Array_Acc;
+ end record;
+
+ function Read_Byte (Addr : Address) return Unsigned_8
+ is
+ type Unsigned_8_Acc is access all Unsigned_8;
+ function To_Unsigned_8_Acc is new Ada.Unchecked_Conversion
+ (Address, Unsigned_8_Acc);
+ begin
+ return To_Unsigned_8_Acc (Addr).all;
+ end Read_Byte;
+
+ procedure Read_Word4 (Addr : in out Address;
+ Res : out Unsigned_32)
+ is
+ B0, B1, B2, B3 : Unsigned_8;
+ begin
+ B0 := Read_Byte (Addr + 0);
+ B1 := Read_Byte (Addr + 1);
+ B2 := Read_Byte (Addr + 2);
+ B3 := Read_Byte (Addr + 3);
+ -- FIXME: we assume little-endian
+ Res := Shift_Left (Unsigned_32 (B3), 24)
+ or Shift_Left (Unsigned_32 (B2), 16)
+ or Shift_Left (Unsigned_32 (B1), 8)
+ or Shift_Left (Unsigned_32 (B0), 0);
+ Addr := Addr + 4;
+ end Read_Word4;
+
+ procedure Read_Word2 (Addr : in out Address;
+ Res : out Unsigned_16)
+ is
+ B0, B1 : Unsigned_8;
+ begin
+ B0 := Read_Byte (Addr + 0);
+ B1 := Read_Byte (Addr + 1);
+ -- FIXME: we assume little-endian
+ Res := Shift_Left (Unsigned_16 (B1), 8)
+ or Shift_Left (Unsigned_16 (B0), 0);
+ Addr := Addr + 2;
+ end Read_Word2;
+
+ procedure Read_Byte (Addr : in out Address;
+ Res : out Unsigned_8)
+ is
+ begin
+ Res := Read_Byte (Addr);
+ Addr := Addr + 1;
+ end Read_Byte;
+
+ procedure Read_ULEB128 (Addr : in out Address;
+ Res : out Unsigned_32)
+ is
+ B : Unsigned_8;
+ Shift : Integer;
+ begin
+ Res := 0;
+ Shift := 0;
+ loop
+ B := Read_Byte (Addr);
+ Addr := Addr + 1;
+ Res := Res or Shift_Left (Unsigned_32 (B and 16#7f#), Shift);
+ exit when (B and 16#80#) = 0;
+ Shift := Shift + 7;
+ end loop;
+ end Read_ULEB128;
+
+ procedure Read_SLEB128 (Addr : in out Address;
+ Res : out Unsigned_32)
+ is
+ B : Unsigned_8;
+ Shift : Integer;
+ begin
+ Res := 0;
+ Shift := 0;
+ loop
+ B := Read_Byte (Addr);
+ Addr := Addr + 1;
+ Res := Res or Shift_Left (Unsigned_32 (B and 16#7f#), Shift);
+ Shift := Shift + 7;
+ exit when (B and 16#80#) = 0;
+ end loop;
+ if Shift < 32 and (Res and Shift_Left (1, Shift - 1)) /= 0 then
+ Res := Res or Shift_Left (-1, Shift);
+ end if;
+ end Read_SLEB128;
+
+ procedure Init_Abbrev (Abbrevs : in out Abbrev_Data;
+ Sections : Dwarf_Sections;
+ Off : Storage_Offset)
+ is
+ Old_Map : Abbrev_Array_Acc;
+ begin
+ Old_Map := Abbrevs.Map;
+ if Old_Map /= null then
+ Old_Map.all := (others => Null_Address);
+ end if;
+
+ Abbrevs := (Sarray => (others => Null_Address),
+ Next_Num => 0,
+ Next_Addr => Sections.Debug_Abbrev.Vaddr + Off,
+ Last_Addr => (Sections.Debug_Abbrev.Vaddr
+ + Sections.Debug_Abbrev.Size),
+ Map => Old_Map);
+ end Init_Abbrev;
+
+ procedure Find_Abbrev (Abbrevs : in out Abbrev_Data;
+ Num : Unsigned_32;
+ Res : out Address)
+ is
+ Code : Unsigned_32;
+ Addr : Address;
+ Tag, Name, Form : Unsigned_32;
+ begin
+ if Num > Abbrevs.Next_Num then
+ -- Not yet decoded.
+ Addr := Abbrevs.Next_Addr;
+
+ while Addr < Abbrevs.Last_Addr loop
+ -- Read abbreviation code.
+ Read_ULEB128 (Addr, Code);
+
+ if Code /= 0 then
+ -- Not a pad.
+
+ -- Insert address in map.
+ if Abbrevs.Map = null then
+ if Code <= Abbrevs.Sarray'Last then
+ Abbrevs.Sarray (Code) := Addr;
+ else
+ raise Program_Error;
+ end if;
+ else
+ if Code <= Abbrevs.Map'Last then
+ Abbrevs.Map (Code) := Addr;
+ else
+ -- Need to expand map.
+ raise Program_Error;
+ end if;
+ end if;
+
+ -- Read tag.
+ Read_ULEB128 (Addr, Tag);
+
+ -- Skip child flag.
+ Addr := Addr + 1;
+
+ -- Skip attribute specifications.
+ loop
+ Read_ULEB128 (Addr, Name);
+ Read_ULEB128 (Addr, Form);
+ exit when Name = 0 and Form = 0;
+ end loop;
+
+ -- Found.
+ exit when Code = Num;
+ end if;
+ end loop;
+
+ -- Next entry to read.
+ Abbrevs.Next_Addr := Addr;
+ end if;
+
+ -- Set result.
+ if Abbrevs.Map = null then
+ Res := Abbrevs.Sarray (Num);
+ else
+ Res := Abbrevs.Map (Num);
+ end if;
+ end Find_Abbrev;
+
+ procedure Read_Uns32 (Addr : in out Address;
+ Form : Unsigned_32;
+ Res : out Unsigned_32) is
+ begin
+ case Form is
+ when DW_FORM_Data4 =>
+ Read_Word4 (Addr, Res);
+ when others =>
+ raise Program_Error;
+ end case;
+ end Read_Uns32;
+
+ procedure Skip_String (Addr : in out Address) is
+ begin
+ while Read_Byte (Addr) /= 0 loop
+ Addr := Addr + 1;
+ end loop;
+ Addr := Addr + 1;
+ end Skip_String;
+
+ procedure Read_Addr (Addr : in out Address;
+ Res : out Address)
+ is
+ function To_Address is new Ada.Unchecked_Conversion
+ (Unsigned_32, Address);
+ V : Unsigned_32;
+ begin
+ Read_Word4 (Addr, V);
+ Res := To_Address (V);
+ end Read_Addr;
+
+ procedure Read_Addr (Addr : in out Address;
+ Form : Unsigned_32;
+ Res : out Address)
+ is
+ begin
+ case Form is
+ when DW_FORM_Addr =>
+ Read_Addr (Addr, Res);
+ when DW_FORM_String =>
+ Res := Addr;
+ Skip_String (Addr);
+ when others =>
+ raise Program_Error;
+ end case;
+ end Read_Addr;
+
+ procedure Read_Ref (Addr : in out Address;
+ Form : Unsigned_32;
+ Base : Address;
+ Res : out Address)
+ is
+ V : Unsigned_32;
+ begin
+ case Form is
+ when DW_FORM_Ref4 =>
+ Read_Word4 (Addr, V);
+ Res := Base + Storage_Offset (V);
+ when others =>
+ raise Program_Error;
+ end case;
+ end Read_Ref;
+
+ procedure Skip_Form (Addr : in out Address;
+ Form : Unsigned_32)
+ is
+ begin
+ case Form is
+ when DW_FORM_Addr =>
+ Addr := Addr + 4;
+ when DW_FORM_Flag =>
+ Addr := Addr + 1;
+ when DW_FORM_Block1 =>
+ Addr := Addr + Storage_Offset (Read_Byte (Addr)) + 1;
+ when DW_FORM_Data1 =>
+ Addr := Addr + 1;
+ when DW_FORM_Data2 =>
+ Addr := Addr + 2;
+ when DW_FORM_Data4 =>
+ Addr := Addr + 4;
+ when DW_FORM_Sdata
+ | DW_FORM_Udata =>
+ while (Read_Byte (Addr) and 16#80#) /= 0 loop
+ Addr := Addr + 1;
+ end loop;
+ Addr := Addr + 1;
+ when DW_FORM_Ref4 =>
+ Addr := Addr + 4;
+ when DW_FORM_Strp =>
+ Addr := Addr + 4;
+ when DW_FORM_String =>
+ Skip_String (Addr);
+ when others =>
+ raise Program_Error;
+ end case;
+ end Skip_Form;
+
+ procedure Find_Subprogram (Pc : Address;
+ Sections : Dwarf_Sections;
+ Res : out Symbolize_Result;
+ Abbrevs : in out Abbrev_Data;
+ Unit_Stmt_List : out Unsigned_32)
+ is
+ Base : Address;
+ Addr : Address;
+ Sect_Last_Addr : Address;
+ Next_Unit_Addr : Address;
+
+ Abbrev : Address;
+
+ Unit_Len : Unsigned_32;
+ Ver : Unsigned_16;
+ Abbrev_Off : Unsigned_32;
+ Ptr_Sz : Unsigned_8;
+ Num : Unsigned_32;
+
+ Tag : Unsigned_32;
+ Abbrev_Name : Unsigned_32;
+ Abbrev_Form : Unsigned_32;
+
+ Level : Unsigned_8;
+
+ Stmt_List : Unsigned_32;
+ Low_Pc : Address;
+ High_Pc : Address;
+ Name : Address;
+ Sibling : Address;
+ begin
+ -- Initialize result.
+ Res := (Filename => Null_Address,
+ Line => 0,
+ Subprg_Name => Null_Address);
+
+ Addr := Sections.Debug_Info.Vaddr;
+ Sect_Last_Addr := Addr + Sections.Debug_Info.Size;
+
+ while Addr < Sect_Last_Addr loop
+ -- Read unit length.
+ Base := Addr;
+ Read_Word4 (Addr, Unit_Len);
+ Next_Unit_Addr := Addr + Storage_Offset (Unit_Len);
+ Read_Word2 (Addr, Ver);
+ Read_Word4 (Addr, Abbrev_Off);
+ Read_Byte (Addr, Ptr_Sz);
+ Level := 0;
+
+ Init_Abbrev (Abbrevs, Sections, Storage_Offset (Abbrev_Off));
+ Unit_Stmt_List := Unsigned_32'Last;
+
+ loop
+ << Again >> null;
+ exit when Addr >= Next_Unit_Addr;
+ -- Read abbrev number.
+ Read_ULEB128 (Addr, Num);
+
+ -- End of children.
+ if Num = 0 then
+ Level := Level - 1;
+ goto Again;
+ end if;
+
+ Find_Abbrev (Abbrevs, Num, Abbrev);
+ if Abbrev = Null_Address then
+ -- Not found...
+ return;
+ end if;
+
+ Read_ULEB128 (Abbrev, Tag);
+ if Read_Byte (Abbrev) /= 0 then
+ Level := Level + 1;
+ end if;
+
+ -- skip child.
+ Abbrev := Abbrev + 1;
+
+ -- We are only interested in a few attributes.
+ Stmt_List := Unsigned_32'Last;
+ Low_Pc := Null_Address;
+ High_Pc := Null_Address;
+ Name := Null_Address;
+ Sibling := Null_Address;
+
+ loop
+ Read_ULEB128 (Abbrev, Abbrev_Name);
+ Read_ULEB128 (Abbrev, Abbrev_Form);
+ exit when Abbrev_Name = 0 and Abbrev_Form = 0;
+ case Abbrev_Name is
+ when DW_AT_Stmt_List =>
+ Read_Uns32 (Addr, Abbrev_Form, Stmt_List);
+ when DW_AT_Low_Pc =>
+ Read_Addr (Addr, Abbrev_Form, Low_Pc);
+ when DW_AT_High_Pc =>
+ Read_Addr (Addr, Abbrev_Form, High_Pc);
+ when DW_AT_Name =>
+ Read_Addr (Addr, Abbrev_Form, Name);
+ when DW_AT_Sibling =>
+ Read_Ref (Addr, Abbrev_Form, Base, Sibling);
+ when others =>
+ Skip_Form (Addr, Abbrev_Form);
+ end case;
+ end loop;
+
+ case Tag is
+ when DW_TAG_Compile_Unit =>
+ if Low_Pc /= Null_Address
+ and then High_Pc /= Null_Address
+ and then (Pc < Low_Pc or Pc > High_Pc)
+ then
+ -- Out of this compile unit.
+ Addr := Next_Unit_Addr;
+ exit;
+ end if;
+ Unit_Stmt_List := Stmt_List;
+ when DW_TAG_Subprogram =>
+ if Low_Pc /= Null_Address
+ and then High_Pc /= Null_Address
+ and then (Pc >= Low_Pc and Pc <= High_Pc)
+ then
+ -- Found!
+ Res.Subprg_Name := Name;
+ return;
+ end if;
+ when DW_TAG_Structure_Type
+ | DW_TAG_Enumeration_Type =>
+ if Sibling /= Null_Address then
+ Addr := Sibling;
+ Level := Level - 1;
+ end if;
+ when others =>
+ null;
+ end case;
+ end loop;
+ end loop;
+ end Find_Subprogram;
+
+ procedure Skip_Filename (Addr : in out Address)
+ is
+ File_Dir : Unsigned_32;
+ File_Time : Unsigned_32;
+ File_Len : Unsigned_32;
+ begin
+ Skip_String (Addr);
+ Read_ULEB128 (Addr, File_Dir);
+ Read_ULEB128 (Addr, File_Time);
+ Read_ULEB128 (Addr, File_Len);
+ end Skip_Filename;
+
+ procedure Find_Lineno (Pc_Addr : Address;
+ Sections : Dwarf_Sections;
+ Res : in out Symbolize_Result;
+ Stmt_List : Storage_Offset)
+ is
+ Addr : Address;
+ Last_Addr : Address;
+ Next_Addr : Address;
+
+ -- Opcode length. Use a fixed bound.
+ Opc_Length : array (Unsigned_8 range 1 .. 32) of Unsigned_8;
+
+ Total_Len : Unsigned_32;
+ Version : Unsigned_16;
+ Prolog_Len : Unsigned_32;
+ Min_Insn_Len : Unsigned_8;
+ Dflt_Is_Stmt : Unsigned_8;
+ Line_Base : Unsigned_8;
+ Line_Range : Unsigned_8;
+ Opc_Base : Unsigned_8;
+
+ B : Unsigned_8;
+ Arg : Unsigned_32;
+
+ File_Names : Address;
+
+ Ext_Len : Unsigned_32;
+ Ext_Opc : Unsigned_8;
+
+ Last : Address;
+
+ Pc : Address;
+ Line : Unsigned_32;
+ Line_Base2 : Unsigned_32;
+ New_Row : Boolean;
+
+ File_Id : Unsigned_32;
+ Prev_File_Id : Unsigned_32;
+ Prev_Pc : Address;
+ Prev_Line : Unsigned_32;
+ begin
+ if Stmt_List >= Sections.Debug_Line.Size then
+ -- Invalid stmt list.
+ return;
+ end if;
+ Addr := Sections.Debug_Line.Vaddr + Stmt_List;
+ Last_Addr := Addr + Sections.Debug_Line.Size - Stmt_List;
+
+ while Addr < Last_Addr loop
+ -- Read header.
+ Read_Word4 (Addr, Total_Len);
+ Last := Addr + Storage_Offset (Total_Len);
+ Read_Word2 (Addr, Version);
+ Read_Word4 (Addr, Prolog_Len);
+ Read_Byte (Addr, Min_Insn_Len);
+ Read_Byte (Addr, Dflt_Is_Stmt);
+ Read_Byte (Addr, Line_Base);
+ Read_Byte (Addr, Line_Range);
+ Read_Byte (Addr, Opc_Base);
+
+ Prev_Pc := Null_Address;
+ Prev_Line := 0;
+ Prev_File_Id := 0;
+ File_Id := 0;
+ New_Row := False;
+ Pc := Null_Address;
+ Line := 1;
+
+ -- Sign extend line base.
+ Line_Base2 := Unsigned_32 (Line_Base);
+ if (Line_Base and 16#80#) /= 0 then
+ Line_Base2 := Line_Base2 or 16#Ff_Ff_Ff_00#;
+ end if;
+
+ -- Read opcodes length.
+ if Opc_Base > Opc_Length'Last then
+ raise Program_Error;
+ end if;
+ for I in 1 .. Opc_Base - 1 loop
+ Read_Byte (Addr, B);
+ Opc_Length (I) := B;
+ end loop;
+
+ -- Include directories.
+ loop
+ B := Read_Byte (Addr);
+ exit when B = 0;
+ Skip_String (Addr);
+ end loop;
+ Addr := Addr + 1;
+
+ -- Filenames.
+ File_Names := Addr;
+ loop
+ B := Read_Byte (Addr);
+ exit when B = 0;
+ Skip_Filename (Addr);
+ end loop;
+ Addr := Addr + 1;
+
+ -- The debug_line 'program'.
+ while Addr < Last loop
+ -- Read opcode.
+ Read_Byte (Addr, B);
+
+ if B = 0 then
+ -- Extended opcode.
+ Read_ULEB128 (Addr, Ext_Len);
+ Next_Addr := Addr;
+ Read_Byte (Addr, Ext_Opc);
+ Next_Addr := Next_Addr + Storage_Offset (Ext_Len);
+ case Ext_Opc is
+ when DW_LNE_End_Sequence =>
+ New_Row := True;
+ when DW_LNE_Set_Address =>
+ Read_Addr (Addr, Pc);
+ when others =>
+ raise Program_Error;
+ end case;
+ pragma Assert (Addr = Next_Addr);
+ elsif B < Opc_Base then
+ -- Standard opcode.
+ case B is
+ when DW_LNS_Copy =>
+ New_Row := True;
+ when DW_LNS_Advance_Pc =>
+ Read_ULEB128 (Addr, Arg);
+ Pc := Pc
+ + Storage_Offset (Arg * Unsigned_32 (Min_Insn_Len));
+ when DW_LNS_Advance_Line =>
+ Read_SLEB128 (Addr, Arg);
+ Line := Line + Arg;
+ when DW_LNS_Const_Add_Pc =>
+ Pc := Pc + Storage_Offset
+ (Unsigned_32 ((255 - Opc_Base) / Line_Range)
+ * Unsigned_32 (Min_Insn_Len));
+ when DW_LNS_Set_File =>
+ Read_ULEB128 (Addr, File_Id);
+ when others =>
+ for J in 1 .. Opc_Length (B) loop
+ Read_ULEB128 (Addr, Arg);
+ end loop;
+ raise Program_Error;
+ end case;
+ else
+ -- Special opcode.
+ B := B - Opc_Base;
+ Pc := Pc + Storage_Offset
+ (Unsigned_32 (B / Line_Range) * Unsigned_32 (Min_Insn_Len));
+ Line := Line + Line_Base2 + Unsigned_32 (B mod Line_Range);
+ New_Row := True;
+ end if;
+
+ if New_Row then
+ New_Row := False;
+ if Pc_Addr >= Prev_Pc and then Pc_Addr < Pc then
+ Res.Line := Natural (Prev_Line);
+
+ -- Search for filename.
+ if Prev_File_Id = 0 then
+ Addr := Null_Address;
+ else
+ Addr := File_Names;
+ while Prev_File_Id > 1 loop
+ exit when Read_Byte (Addr) = 0;
+ Skip_Filename (Addr);
+ Prev_File_Id := Prev_File_Id - 1;
+ end loop;
+ end if;
+ Res.Filename := Addr;
+
+ return;
+ end if;
+ Prev_Pc := Pc;
+ Prev_Line := Line;
+ Prev_File_Id := File_Id;
+ end if;
+ end loop;
+ end loop;
+ end Find_Lineno;
+
+ procedure Symbolize_Address (Pc : Address;
+ Sections : Dwarf_Sections;
+ Res : out Symbolize_Result)
+ is
+ Abbrevs : Abbrev_Data;
+ Unit_Stmt_List : Unsigned_32;
+ begin
+ Find_Subprogram (Pc, Sections, Res, Abbrevs, Unit_Stmt_List);
+
+ if Unit_Stmt_List /= Unsigned_32'Last then
+ Find_Lineno (Pc, Sections, Res, Storage_Offset (Unit_Stmt_List));
+ end if;
+ end Symbolize_Address;
+end Symbolizer;
diff --git a/src/ortho/mcode/symbolizer.ads b/src/ortho/mcode/symbolizer.ads
new file mode 100644
index 0000000..c31b948
--- /dev/null
+++ b/src/ortho/mcode/symbolizer.ads
@@ -0,0 +1,48 @@
+-- Dwarf symbolizer.
+-- Copyright (C) 2015 Tristan Gingold
+--
+-- GHDL is free software; you can redistribute it and/or modify it under
+-- the terms of the GNU General Public License as published by the Free
+-- Software Foundation; either version 2, or (at your option) any later
+-- version.
+--
+-- GHDL is distributed in the hope that it will be useful, but WITHOUT 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
+-- along with GCC; see the file COPYING. If not, write to the Free
+-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+-- 02111-1307, USA.
+
+with System.Storage_Elements;
+use System; use System.Storage_Elements;
+
+package Symbolizer is
+ -- Address (in memory) and size of a debug section.
+ type Section_Content is record
+ Vaddr : Address;
+ Size : Storage_Offset;
+ end record;
+
+ -- Input sections.
+ type Dwarf_Sections is record
+ Debug_Line : Section_Content;
+ Debug_Info : Section_Content;
+ Debug_Abbrev : Section_Content;
+ end record;
+
+ -- The result, using C strings.
+ type Symbolize_Result is record
+ Filename : Address;
+ Line : Natural;
+ Subprg_Name : Address;
+ end record;
+
+ -- Translate PC to filename, line number and subprogram name using dwarf
+ -- debug infos.
+ procedure Symbolize_Address (Pc : Address;
+ Sections : Dwarf_Sections;
+ Res : out Symbolize_Result);
+end Symbolizer;