diff options
Diffstat (limited to 'src/ortho/mcode')
| -rw-r--r-- | src/ortho/mcode/binary_file-format.ads | 20 | ||||
| -rw-r--r-- | src/ortho/mcode/binary_file-memory.adb | 26 | ||||
| -rw-r--r-- | src/ortho/mcode/binary_file-memory.ads | 11 | ||||
| -rw-r--r-- | src/ortho/mcode/dwarf.ads | 3 | ||||
| -rw-r--r-- | src/ortho/mcode/ortho_code-dwarf.adb | 174 | ||||
| -rw-r--r-- | src/ortho/mcode/ortho_code-dwarf.ads | 8 | ||||
| -rw-r--r-- | src/ortho/mcode/ortho_code-flags.ads | 4 | ||||
| -rw-r--r-- | src/ortho/mcode/ortho_code-x86-abi.adb | 9 | ||||
| -rw-r--r-- | src/ortho/mcode/ortho_code-x86-emits.adb | 8 | ||||
| -rw-r--r-- | src/ortho/mcode/ortho_code_main.adb | 5 | ||||
| -rw-r--r-- | src/ortho/mcode/ortho_jit.adb | 52 | ||||
| -rw-r--r-- | src/ortho/mcode/symbolizer.adb | 655 | ||||
| -rw-r--r-- | src/ortho/mcode/symbolizer.ads | 48 |
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 000000000..57a65b70d --- /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 a37af9cb7..9797cd6b9 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 a205da527..cc2b7e39b 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 40ee94f10..8a3058c0e 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 309c82dea..521ab85f3 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 c120bcfe1..095a80da6 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 214cc743b..30bded94e 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 2be10fe0e..0a4433941 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 412080150..c4cfee930 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 c515f581c..b3a2e1988 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 907aea0b6..f01c8fafa 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 000000000..79e7de24e --- /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 000000000..c31b948f4 --- /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; |