1-- Ortho JIT implementation for mcode. 2-- Copyright (C) 2009 - 2015 Tristan Gingold 3-- 4-- This program is free software: you can redistribute it and/or modify 5-- it under the terms of the GNU General Public License as published by 6-- the Free Software Foundation, either version 2 of the License, or 7-- (at your option) any later version. 8-- 9-- This program is distributed in the hope that it will be useful, 10-- but WITHOUT ANY WARRANTY; without even the implied warranty of 11-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12-- GNU General Public License for more details. 13-- 14-- You should have received a copy of the GNU General Public License 15-- along with this program. If not, see <gnu.org/licenses>. 16 17with System.Storage_Elements; use System.Storage_Elements; 18 19with GNAT.OS_Lib; use GNAT.OS_Lib; 20with Ada.Text_IO; 21 22with Binary_File; use Binary_File; 23with Binary_File.Memory; 24with Ortho_Mcode; 25with Ortho_Mcode.Jit; 26with Ortho_Code.Flags; use Ortho_Code.Flags; 27with Ortho_Code.Debug; 28with Ortho_Code.Abi; 29with Ortho_Code.Dwarf; 30with Binary_File.Format; 31with Symbolizer; 32 33package body Ortho_Jit is 34 Snap_Filename : GNAT.OS_Lib.String_Access := null; 35 36 -- Initialize the whole engine. 37 procedure Init is 38 begin 39 Ortho_Mcode.Init; 40 Binary_File.Memory.Write_Memory_Init; 41 end Init; 42 43 -- Set address of non-defined global variables or functions. 44 procedure Set_Address (Decl : O_Dnode; Addr : Address) 45 renames Ortho_Mcode.Jit.Set_Address; 46 47 -- Get address of a global. 48 function Get_Address (Decl : O_Dnode) return Address 49 renames Ortho_Mcode.Jit.Get_Address; 50 51 -- Do link. 52 procedure Link (Status : out Boolean) is 53 begin 54 if Ortho_Code.Debug.Flag_Debug_Hli then 55 -- Can't generate code in HLI. 56 Status := True; 57 return; 58 end if; 59 60 Ortho_Mcode.Finish; 61 62 Ortho_Code.Abi.Link_Intrinsics; 63 64 Binary_File.Memory.Write_Memory_Relocate (Status); 65 if Status then 66 return; 67 end if; 68 69 if Snap_Filename /= null then 70 declare 71 use Ada.Text_IO; 72 Fd : File_Descriptor; 73 begin 74 Fd := Create_File (Snap_Filename.all, Binary); 75 if Fd = Invalid_FD then 76 Put_Line (Standard_Error, 77 "can't open '" & Snap_Filename.all & "'"); 78 Status := False; 79 return; 80 else 81 Binary_File.Format.Write (Fd); 82 Close (Fd); 83 end if; 84 end; 85 end if; 86 end Link; 87 88 procedure Finish is 89 begin 90 -- Free all the memory. 91 Ortho_Mcode.Free_All; 92 93 Binary_File.Finish; 94 end Finish; 95 96 function Decode_Option (Option : String) return Boolean 97 is 98 Opt : constant String (1 .. Option'Length) := Option; 99 begin 100 if Opt = "-g" then 101 Flag_Debug := Debug_Dwarf; 102 return True; 103 elsif Opt = "-g0" then 104 Flag_Debug := Debug_None; 105 return True; 106 elsif Opt'Length > 5 and then Opt (1 .. 5) = "--be-" then 107 Ortho_Code.Debug.Set_Be_Flag (Opt); 108 return True; 109 elsif Opt'Length > 7 and then Opt (1 .. 7) = "--snap=" then 110 Snap_Filename := new String'(Opt (8 .. Opt'Last)); 111 return True; 112 else 113 return False; 114 end if; 115 end Decode_Option; 116 117 procedure Disp_Help is 118 use Ada.Text_IO; 119 begin 120 Put_Line (" -g Generate debugging informations"); 121 Put_Line (" -g0 Do not generate any debugging informations"); 122 Put_Line (" --debug-be=X Set X internal debugging flags"); 123 Put_Line (" --snap=FILE Write memory snapshot to FILE"); 124 end Disp_Help; 125 126 function Get_Jit_Name return String is 127 begin 128 return "mcode"; 129 end Get_Jit_Name; 130 131 procedure Symbolize (Pc : Address; 132 Filename : out Address; 133 Lineno : out Natural; 134 Subprg : out Address) 135 is 136 use Binary_File.Memory; 137 use Symbolizer; 138 139 function Get_Section_Content (Sect : Section_Acc) return Section_Content 140 is 141 Addr : Address; 142 Size : Pc_Type; 143 begin 144 if Sect = null then 145 return (Null_Address, 0); 146 else 147 Addr := Get_Section_Addr (Sect); 148 Size := Get_Section_Size (Sect); 149 return (Addr, Storage_Offset (Size)); 150 end if; 151 end Get_Section_Content; 152 153 Sections : Dwarf_Sections; 154 Res : Symbolize_Result; 155 begin 156 Sections.Debug_Line := 157 Get_Section_Content (Ortho_Code.Dwarf.Line_Sect); 158 Sections.Debug_Info := 159 Get_Section_Content (Ortho_Code.Dwarf.Info_Sect); 160 Sections.Debug_Abbrev := 161 Get_Section_Content (Ortho_Code.Dwarf.Abbrev_Sect); 162 163 Symbolize_Address (Pc, Sections, Res); 164 165 Filename := Res.Filename; 166 Lineno := Res.Line; 167 Subprg := Res.Subprg_Name; 168 end Symbolize; 169 170end Ortho_Jit; 171