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