1
------------------------------------------------------------------------------
2
--                                                                          --
3
--                           OCARINA COMPONENTS                             --
4
--                                                                          --
5
--                     O C A R I N A . B A C K E N D S                      --
6
--                                                                          --
7
--                                 B o d y                                  --
8
--                                                                          --
9
--               Copyright (C) 2008-2009 Telecom ParisTech,                 --
10
--                 2010-2019 ESA & ISAE, 2019-2020 OpenAADL                 --
11
--                                                                          --
12
-- Ocarina  is free software; you can redistribute it and/or modify under   --
13
-- terms of the  GNU General Public License as published  by the Free Soft- --
14
-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
15
-- sion. Ocarina is distributed in the hope that it will be useful, but     --
16
-- WITHOUT ANY WARRANTY; without even the implied warranty of               --
17
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                     --
18
--                                                                          --
19
-- As a special exception under Section 7 of GPL version 3, you are granted --
20
-- additional permissions described in the GCC Runtime Library Exception,   --
21
-- version 3.1, as published by the Free Software Foundation.               --
22
--                                                                          --
23
-- You should have received a copy of the GNU General Public License and    --
24
-- a copy of the GCC Runtime Library Exception along with this program;     --
25
-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
26
-- <http://www.gnu.org/licenses/>.                                          --
27
--                                                                          --
28
--                    Ocarina is maintained by OpenAADL team                --
29
--                              (info@openaadl.org)                         --
30
--                                                                          --
31
------------------------------------------------------------------------------
32

33
with GNAT.OS_Lib; use GNAT.OS_Lib;
34
with GNAT.Table;
35

36
with Charset;        use Charset;
37
with Ocarina.Namet;  use Ocarina.Namet;
38
with Ocarina.Output; use Ocarina.Output;
39
with Errors;         use Errors;
40

41
with Ocarina.Backends.Build_Utils;
42
with Ocarina.Backends.Messages;
43
with Ocarina.Backends.PN;
44

45
with Ocarina.Backends.ARINC653_Conf;
46
with Ocarina.Backends.Deos_Conf;
47
with Ocarina.Backends.Vxworks653_Conf;
48
with Ocarina.Backends.PO_HI_Ada;
49
with Ocarina.Backends.ASN1;
50
with Ocarina.Backends.PO_HI_C;
51
with Ocarina.Backends.Stats;
52
with Ocarina.Backends.Subprograms;
53
with Ocarina.Backends.Cheddar;
54
with Ocarina.Backends.Connection_Matrix;
55
with Ocarina.Backends.Functions_Matrix;
56
with Ocarina.Backends.MAST;
57
with Ocarina.Backends.MAST_Values;
58
with Ocarina.Backends.MAST_Tree.Nodes;
59
with Ocarina.Backends.MAST_Tree.Nutils;
60
with Ocarina.Backends.POK_C;
61
with Ocarina.Backends.Properties;
62
with Ocarina.Backends.Ada_Tree.Nodes;
63
with Ocarina.Backends.Ada_Tree.Nutils;
64
with Ocarina.Backends.Ada_Values;
65
with Ocarina.Backends.C_Tree.Nodes;
66
with Ocarina.Backends.C_Tree.Nutils;
67
with Ocarina.Backends.C_Values;
68
with Ocarina.Backends.XML_Values;
69
with Ocarina.Backends.XML_Tree.Nutils;
70
with Ocarina.Backends.BoundT;
71
with Ocarina.Backends.REAL;
72
with Ocarina.Backends.LNT;
73
with Ocarina.Backends.Replication_Expander;
74
with Ocarina.Backends.Xtratum_Conf;
75
with Ocarina.Backends.AIR_Conf;
76
with Ocarina.Backends.ASN1_Tree.Nodes;
77
with Ocarina.Backends.ASN1_Tree.Nutils;
78
with Ocarina.Backends.ASN1_Values;
79
with Ocarina.Backends.AADL_XML;
80
with Ocarina.Backends.Alloy;
81

82
with Ocarina.Options; use Ocarina.Options;
83

84 1
package body Ocarina.Backends is
85

86
   use Ocarina.Backends.Messages;
87

88
   Current_Backend_Name : Name_Id      := No_Name;
89
   Current_Backend_Kind : Backend_Kind := Invalid_Backend;
90

91
   type Backend_Record is record
92
      Name    : Name_Id;
93
      Process : Backend_Subprogram;
94
      Kind    : Backend_Kind;
95
   end record;
96

97
   package Backend_Table is new GNAT.Table
98
     (Backend_Record,
99
      Natural,
100
      1,
101
      10,
102
      10);
103

104
   -------------------
105
   -- Generate_Code --
106
   -------------------
107

108 1
   procedure Generate_Code
109
     (Root         : Node_Id;
110
      Backend_Name : Name_Id := No_Name)
111
   is
112 1
      Current_Backend : Natural := 0;
113

114
   begin
115

116
      --  FIXME: Select the code generator according to information
117
      --  given in the instance root system.
118

119 1
      if Backend_Name /= No_Name then
120 1
         Current_Backend :=  Get_Backend (Backend_Name);
121

122 1
         if Current_Backend /= 0 then
123
            Current_Backend_Kind := Backend_Table.Table (Current_Backend).Kind;
124
         end if;
125

126 1
      elsif Current_Backend_Name = No_Name then
127 0
         Display_Error ("No backend name specified", Fatal => True);
128

129
      else
130 1
         Current_Backend :=  Get_Backend (Current_Backend_Name);
131

132 1
         if Current_Backend /= 0 then
133
            Current_Backend_Kind := Backend_Table.Table (Current_Backend).Kind;
134
         end if;
135
      end if;
136

137 1
      if Current_Backend = 0 then
138 0
         Ocarina.Backends.Messages.Display_Error
139 0
           ("Cannot find backend " & Get_Name_String (Current_Backend_Name),
140
            Fatal => True);
141
      end if;
142

143
      --  Call the current generator entry point
144

145
      Backend_Table.Table (Current_Backend).Process (Root);
146

147
   exception
148 0
      when E : others =>
149 0
         Errors.Display_Bug_Box (E);
150
   end Generate_Code;
151

152
   -----------------
153
   -- Get_Backend --
154
   -----------------
155

156 1
   function Get_Backend (Backend_Name : Name_Id := No_Name) return Natural is
157 1
      Current_Backend : Natural := 0;
158
   begin
159 1
      if Backend_Name /= No_Name then
160
         for B in Backend_Table.First .. Backend_Table.Last loop
161

162
            if Backend_Table.Table (B).Name = Backend_Name then
163 1
               Current_Backend      := B;
164 1
               exit;
165
            end if;
166 1
         end loop;
167
      end if;
168

169 1
      return Current_Backend;
170
   end Get_Backend;
171

172
   ------------------------------
173
   -- Get_Current_Backend_Kind --
174
   ------------------------------
175

176 1
   function Get_Current_Backend_Kind return Backend_Kind is
177
   begin
178 1
      return Current_Backend_Kind;
179
   end Get_Current_Backend_Kind;
180

181
   ----------
182
   -- Init --
183
   ----------
184

185 1
   procedure Init is
186
   begin
187 1
      Backend_Table.Init;
188 1
      Properties.Init;
189 1
      Ada_Tree.Nutils.Initialize;
190 1
      C_Tree.Nutils.Initialize;
191 1
      XML_Tree.Nutils.Initialize;
192 1
      MAST_Tree.Nutils.Initialize;
193 1
      ASN1_Tree.Nutils.Initialize;
194

195 1
      if Generated_Sources_Directory = No_Name then
196 1
         Generated_Sources_Directory := Get_String_Name (".");
197
      end if;
198

199 1
      Compile_Generated_Sources :=
200 1
        Compile_Generated_Sources
201 1
        or else Do_Regression_Test
202 1
        or else Do_Coverage_Test;
203

204
      --  Register the code generators
205

206 1
      Ocarina.Backends.ARINC653_Conf.Init;
207 1
      Ocarina.Backends.Vxworks653_Conf.Init;
208 1
      Ocarina.Backends.Deos_Conf.Init;
209 1
      PN.Init;
210 1
      BoundT.Init;
211 1
      MAST.Init;
212 1
      PO_HI_Ada.Init;
213 1
      PO_HI_C.Init;
214 1
      POK_C.Init;
215 1
      Xtratum_Conf.Init;
216 1
      Stats.Init;
217 1
      Subprograms.Init;
218 1
      REAL.Init;
219 1
      ASN1.Init;
220 1
      Cheddar.Init;
221 1
      LNT.Init;
222 1
      Replication_Expander.Init;
223 1
      Connection_Matrix.Init;
224 1
      Functions_Matrix.Init;
225 1
      AADL_XML.Init;
226 1
      Alloy.Init;
227 1
      AIR_Conf.Init;
228 1
   end Init;
229

230
   ----------------------
231
   -- Register_Backend --
232
   ----------------------
233

234
   procedure Register_Backend
235
     (Name    : String;
236
      Process : Backend_Subprogram;
237
      Kind    : Backend_Kind)
238
   is
239 1
      N : Name_Id;
240

241
   begin
242
      --  If the installation directory is unknown, we do not register
243
      --  the backend to avoid any future error.
244

245 1
      if Installation_Directory = No_Name then
246 0
         return;
247
      end if;
248

249 1
      Get_Name_String (Installation_Directory);
250 1
      Add_Str_To_Name_Buffer ("include" & Directory_Separator);
251 1
      Add_Str_To_Name_Buffer ("ocarina" & Directory_Separator);
252 1
      Add_Str_To_Name_Buffer ("runtime" & Directory_Separator);
253

254
      --  If the runtime is not installed, we do not register the
255
      --  backend to avoid any future error.
256

257
      if not Is_Directory (Name_Buffer (1 .. Name_Len)) then
258 0
         return;
259
      end if;
260

261 1
      N := Get_String_Name (To_Lower (Name));
262
      for B in Backend_Table.First .. Backend_Table.Last loop
263
         if Backend_Table.Table (B).Name = N then
264 0
            Display_Error
265 0
              ("Cannot register twice backend " & Name,
266
               Fatal => True);
267
         end if;
268 1
      end loop;
269

270 1
      Backend_Table.Increment_Last;
271
      Backend_Table.Table (Backend_Table.Last).Name    := N;
272
      Backend_Table.Table (Backend_Table.Last).Process := Process;
273
      Backend_Table.Table (Backend_Table.Last).Kind    := Kind;
274
   end Register_Backend;
275

276
   -----------
277
   -- Reset --
278
   -----------
279

280 1
   procedure Reset is
281
   begin
282 1
      PO_HI_Ada.Reset;
283 1
      PO_HI_C.Reset;
284 1
      POK_C.Reset;
285 1
      Xtratum_Conf.Reset;
286 1
      Stats.Reset;
287 1
      Connection_Matrix.Reset;
288 1
      Functions_Matrix.Reset;
289

290 1
      Ada_Tree.Nutils.Reset;
291 1
      C_Tree.Nutils.Reset;
292 1
      ASN1_Tree.Nutils.Reset;
293 1
      MAST_Tree.Nutils.Reset;
294

295 1
      Ada_Tree.Nodes.Entries.Free;
296 1
      Ada_Tree.Nodes.Entries.Init;
297 1
      Ada_Values.Reset;
298

299 1
      C_Tree.Nodes.Entries.Free;
300 1
      C_Tree.Nodes.Entries.Init;
301 1
      C_Values.Reset;
302

303 1
      MAST_Tree.Nodes.Entries.Free;
304 1
      MAST_Tree.Nodes.Entries.Init;
305 1
      MAST_Values.Reset;
306

307 1
      XML_Values.Reset;
308 1
      BoundT.Reset;
309 1
      REAL.Reset;
310 1
      LNT.Reset;
311

312 1
      ASN1_Tree.Nodes.Entries.Free;
313 1
      ASN1_Tree.Nodes.Entries.Init;
314 1
      ASN1_Values.Reset;
315

316 1
      MAST_Tree.Nodes.Entries.Free;
317 1
      MAST_Tree.Nodes.Entries.Init;
318 1
      MAST_Values.Reset;
319

320 1
      Alloy.Reset;
321

322 1
      Build_Utils.Reset;
323 1
   end Reset;
324

325
   ------------------------------
326
   -- Set_Current_Backend_Name --
327
   ------------------------------
328

329
   procedure Set_Current_Backend_Name (Name : String) is
330
   begin
331 1
      Current_Backend_Name := Get_String_Name (To_Lower (Name));
332 1
   end Set_Current_Backend_Name;
333

334
   ------------------------------
335
   -- Get_Current_Backend_Name --
336
   ------------------------------
337

338 0
   function Get_Current_Backend_Name return Name_Id is
339
   begin
340 0
      return Current_Backend_Name;
341
   end Get_Current_Backend_Name;
342

343
   --------------------
344
   -- Write_Backends --
345
   --------------------
346

347 0
   procedure Write_Backends (Indent : Natural) is
348
   begin
349 0
      for Index in 1 .. Indent loop
350 0
         Write_Char (' ');
351 0
      end loop;
352

353 0
      Write_Line ("Registered backends:");
354

355 0
      for B in Backend_Table.First .. Backend_Table.Last loop
356 0
         if Backend_Table.Table (B).Name /= No_Name then
357 0
            for Index in 1 .. Indent + 1 loop
358 0
               Write_Char (' ');
359 0
            end loop;
360

361 0
            Write_Name (Backend_Table.Table (B).Name);
362 0
            Write_Eol;
363
         end if;
364 0
      end loop;
365 0
   end Write_Backends;
366

367 1
end Ocarina.Backends;

Read our documentation on viewing source code .

Loading