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

32
with Utils;         use Utils;
33
with Ocarina.Namet; use Ocarina.Namet;
34

35
with Ocarina.ME_AADL;
36

37
with Ocarina.ME_AADL.AADL_Instances.Entities;
38
with Ocarina.ME_AADL.AADL_Instances.Nodes;
39
with Ocarina.ME_AADL.AADL_Instances.Nutils;
40

41
with Ocarina.Backends.Properties;
42
with Ocarina.Backends.Properties.ARINC653;
43

44
with Ocarina.Backends.Utils;
45
with Ocarina.Backends.XML_Tree.Nodes;
46
with Ocarina.Backends.XML_Tree.Nutils;
47
with Ocarina.Backends.XML_Values;
48
with Ocarina.Backends.C_Common.Mapping;
49

50
package body Ocarina.Backends.AIR_Conf.AIR_Configuration is
51

52
   use Ocarina.ME_AADL;
53
   use Ocarina.ME_AADL.AADL_Instances.Nodes;
54
   use Ocarina.ME_AADL.AADL_Instances.Entities;
55

56
   use Ocarina.Backends.Properties;
57
   use Ocarina.Backends.Properties.ARINC653;
58
   use Ocarina.Backends.Utils;
59
   use Ocarina.Backends.XML_Tree.Nutils;
60
   use Ocarina.Backends.C_Common.Mapping;
61

62
   package AIN renames Ocarina.ME_AADL.AADL_Instances.Nodes;
63
   package AINU renames Ocarina.ME_AADL.AADL_Instances.Nutils;
64
   package XTN renames Ocarina.Backends.XML_Tree.Nodes;
65
   package XTU renames Ocarina.Backends.XML_Tree.Nutils;
66
   package XV renames Ocarina.Backends.XML_Values;
67

68
   procedure Visit_Architecture_Instance (E : Node_Id);
69
   procedure Visit_Component_Instance (E : Node_Id);
70
   procedure Visit_System_Instance (E : Node_Id);
71
   procedure Visit_Processor_Instance (E : Node_Id);
72
   procedure Visit_Subcomponents_Of is new Visit_Subcomponents_Of_G (Visit);
73

74
   -----------
75
   -- Visit --
76
   -----------
77

78 1
   procedure Visit (E : Node_Id) is
79
   begin
80 1
      case Kind (E) is
81 1
         when K_Architecture_Instance =>
82 1
            Visit_Architecture_Instance (E);
83

84 1
         when K_Component_Instance =>
85 1
            Visit_Component_Instance (E);
86

87 0
         when others =>
88 0
            null;
89 1
      end case;
90 1
   end Visit;
91

92
   ---------------------------------
93
   -- Visit_Architecture_Instance --
94
   ---------------------------------
95

96 1
   procedure Visit_Architecture_Instance (E : Node_Id) is
97
   begin
98 1
      Visit (Root_System (E));
99 1
   end Visit_Architecture_Instance;
100

101
   ------------------------------
102
   -- Visit_Component_Instance --
103
   ------------------------------
104

105 1
   procedure Visit_Component_Instance (E : Node_Id) is
106 1
      Category : constant Component_Category := Get_Category_Of_Component (E);
107
   begin
108 1
      case Category is
109 1
         when CC_System =>
110 1
            Visit_System_Instance (E);
111

112 1
         when CC_Processor =>
113 1
            Visit_Processor_Instance (E);
114

115 1
         when others =>
116 1
            null;
117 1
      end case;
118 1
   end Visit_Component_Instance;
119

120
   --------------------------
121
   -- Map_Connection_Table --
122
   --------------------------
123

124
   procedure Map_Connection_Table (E : Node_Id)
125 1
     with Pre => (Get_Category_Of_Component (E) = CC_System);
126

127 1
   procedure Map_Connection_Table (E : Node_Id) is
128 1
      Channel_Identifier : Unsigned_Long_Long := 0;
129 1
      C                     : Node_Id;
130 1
      P                     : Node_Id;
131 1
      Q                     : Node_Id;
132 1
      Source_Port_Name      : Name_Id;
133 1
      Destination_Port_Name : Name_Id;
134 1
      Destination_Partition : Node_Id;
135 1
      Source_Partition      : Node_Id;
136 1
      Connection_Table_Node : Node_Id;
137 1
      Channel_Node          : Node_Id;
138 1
      Source_Node           : Node_Id;
139 1
      Destination_Node      : Node_Id;
140 1
      Standard_Partition_Node : Node_Id;
141

142
   begin
143 1
      if not AINU.Is_Empty (Connections (E)) then
144

145 1
         Append_Node_To_List
146 1
           (Make_XML_Comment (Get_String_Name ("Connection Table")),
147 1
            XTN.Subitems (Current_XML_Node));
148

149 1
         Connection_Table_Node := Make_XML_Node ("Connection_Table");
150

151 1
         C := First_Node (Connections (E));
152 1
         while Present (C) loop
153

154 1
            if Kind (C) = K_Connection_Instance then
155
               Source_Port_Name :=
156 1
                 Map_C_Enumerator_Name
157 1
                 (AIN.Item
158 1
                    (AIN.Next_Node
159 1
                       (AIN.First_Node (AIN.Path (AIN.Source (C))))),
160
                  Fully_Qualify_Parent => True);
161

162
               Destination_Port_Name :=
163 1
                 Map_C_Enumerator_Name
164 1
                 (AIN.Item
165 1
                    (AIN.Next_Node
166 1
                       (AIN.First_Node
167 1
                          (AIN.Path (AIN.Destination (C))))),
168
                  Fully_Qualify_Parent => True);
169

170
               Source_Partition :=
171 1
                 AIN.Corresponding_Instance
172 1
                   (AIN.Item (AIN.First_Node (AIN.Path (AIN.Source (C)))));
173

174
               Destination_Partition :=
175 1
                 AIN.Corresponding_Instance
176 1
                   (AIN.Item
177 1
                      (AIN.First_Node (AIN.Path (AIN.Destination (C)))));
178

179
               --  Channel node
180

181 1
               Channel_Node := Make_XML_Node ("Channel");
182 1
               Append_Node_To_List
183
                 (Channel_Node,
184 1
                  XTN.Subitems (Connection_Table_Node));
185

186
               --  Channel identifier
187

188 1
               Set_Str_To_Name_Buffer ("ChannelIdentifier");
189 1
               P := Make_Defining_Identifier (Name_Find);
190 1
               Set_Str_To_Name_Buffer ("");
191 1
               Add_ULL_To_Name_Buffer (Channel_Identifier, 10);
192 1
               Q := Make_Defining_Identifier (Remove_Char (Name_Find, ' '));
193

194 1
               Append_Node_To_List (Make_Assignement (P, Q),
195 1
                                    XTN.Items (Channel_Node));
196 1
               Channel_Identifier := Channel_Identifier + 1;
197

198
               --  Channel name
199

200 1
               XTU.Add_Attribute ("ChannelName",
201 1
                                  Get_Name_String
202 1
                                    (To_Lower
203 1
                                       (Display_Name
204 1
                                          (Identifier (C)))), Channel_Node);
205

206
               --  Mapping of the source
207

208 1
               Source_Node := Make_XML_Node ("Source");
209 1
               Append_Node_To_List (Source_Node, XTN.Subitems (Channel_Node));
210

211 1
               Standard_Partition_Node := Make_XML_Node ("Standard_Partition");
212 1
               Append_Node_To_List (Standard_Partition_Node,
213 1
                                    XTN.Subitems (Source_Node));
214

215 1
               Set_Str_To_Name_Buffer ("PartitionIdentifier");
216 1
               P := Make_Defining_Identifier (Name_Find);
217
               Q :=
218 1
                 Make_Literal
219 1
                   (XV.New_Numeric_Value
220 1
                      (Get_Partition_Identifier
221 1
                         (Get_Bound_Processor (Source_Partition)),
222
                       0,
223
                       10));
224 1
               Append_Node_To_List
225 1
                 (Make_Assignement (P, Q),
226 1
                  XTN.Items (Standard_Partition_Node));
227

228 1
               Set_Str_To_Name_Buffer ("PartitionName");
229 1
               P := Make_Defining_Identifier (Name_Find);
230 1
               Get_Name_String
231 1
                 (To_Lower
232 1
                    (Display_Name
233 1
                       (Identifier
234 1
                          (Parent_Subcomponent (Source_Partition)))));
235 1
               Q := Make_Defining_Identifier (Name_Find);
236 1
               Append_Node_To_List
237 1
                 (Make_Assignement (P, Q),
238 1
                  XTN.Items (Standard_Partition_Node));
239

240 1
               Set_Str_To_Name_Buffer ("PortName");
241 1
               P := Make_Defining_Identifier (Name_Find);
242 1
               Get_Name_String (Source_Port_Name);
243 1
               Q := Make_Defining_Identifier (Name_Find);
244 1
               Append_Node_To_List
245 1
                 (Make_Assignement (P, Q),
246 1
                  XTN.Items (Standard_Partition_Node));
247

248
               --  Mapping of the destination
249

250 1
               Destination_Node := Make_XML_Node ("Destination");
251 1
               Append_Node_To_List
252
                 (Destination_Node,
253 1
                  XTN.Subitems (Channel_Node));
254

255 1
               Standard_Partition_Node := Make_XML_Node ("Standard_Partition");
256 1
               Append_Node_To_List (Standard_Partition_Node,
257 1
                                    XTN.Subitems (Destination_Node));
258

259 1
               Set_Str_To_Name_Buffer ("PartitionIdentifier");
260 1
               P := Make_Defining_Identifier (Name_Find);
261
               Q :=
262 1
                 Make_Literal
263 1
                   (XV.New_Numeric_Value
264 1
                      (Get_Partition_Identifier
265 1
                         (Get_Bound_Processor
266
                         (Destination_Partition)),
267
                       0,
268
                       10));
269 1
               Append_Node_To_List
270 1
                 (Make_Assignement (P, Q),
271 1
                  XTN.Items (Standard_Partition_Node));
272

273 1
               Set_Str_To_Name_Buffer ("PartitionName");
274 1
               P := Make_Defining_Identifier (Name_Find);
275 1
               Get_Name_String
276 1
                 (To_Lower
277 1
                    (Display_Name
278 1
                       (Identifier
279 1
                          (Parent_Subcomponent (Destination_Partition)))));
280 1
               Q := Make_Defining_Identifier (Name_Find);
281 1
               Append_Node_To_List
282 1
                 (Make_Assignement (P, Q),
283 1
                  XTN.Items (Standard_Partition_Node));
284

285 1
               Set_Str_To_Name_Buffer ("PortName");
286 1
               P := Make_Defining_Identifier (Name_Find);
287 1
               Get_Name_String (Destination_Port_Name);
288 1
               Q := Make_Defining_Identifier (Name_Find);
289 1
               Append_Node_To_List
290 1
                 (Make_Assignement (P, Q),
291 1
                  XTN.Items (Standard_Partition_Node));
292
            end if;
293

294 1
            C := Next_Node (C);
295 1
         end loop;
296

297 1
         Append_Node_To_List (Connection_Table_Node,
298 1
                              XTN.Subitems (Current_XML_Node));
299
      end if;
300 1
   end Map_Connection_Table;
301

302
   ---------------------------
303
   -- Visit_System_Instance --
304
   ---------------------------
305

306 1
   procedure Visit_System_Instance (E : Node_Id) is
307 1
      U : Node_Id;
308 1
      R : Node_Id;
309
   begin
310 1
      U := XTN.Unit (Backend_Node (Identifier (E)));
311 1
      R := XTN.Node (Backend_Node (Identifier (E)));
312

313 1
      Current_XML_Node := XTN.Root_Node (XTN.XML_File (U));
314

315 1
      Push_Entity (U);
316 1
      Push_Entity (R);
317

318 1
      Map_Connection_Table (E);
319 1
      Visit_Subcomponents_Of (E);
320

321 1
      Pop_Entity;
322 1
      Pop_Entity;
323 1
   end Visit_System_Instance;
324

325
   procedure Map_AIR_Configuration_Node (E : Node_Id)
326 1
     with Pre => (Get_Category_Of_Component (E) = CC_Processor);
327

328
   --------------------------------
329
   -- Map_AIR_Configuration_Node --
330
   --------------------------------
331

332 1
   procedure Map_AIR_Configuration_Node (E : Node_Id) is
333 1
      AIR_Configuration_Node : Node_Id;
334 1
      P : Node_Id;
335 1
      Q : Node_Id;
336
   begin
337

338 1
      Append_Node_To_List
339 1
        (Make_XML_Comment (Get_String_Name ("Module configuration")),
340 1
         XTN.Subitems (Current_XML_Node));
341

342
      --  Create the AIR_Configuration node
343

344 1
      AIR_Configuration_Node := Make_XML_Node ("AIR_Configuration");
345

346 1
      Set_Str_To_Name_Buffer ("TicksPerSecond");
347 1
      P := Make_Defining_Identifier (Name_Find);
348 1
      Set_Str_To_Name_Buffer ("200"); --  XXX Hardcoded ?
349 1
      Q := Make_Defining_Identifier (Name_Find);
350

351 1
      Append_Node_To_List
352 1
        (Make_Assignement (P, Q),
353 1
         XTN.Items (AIR_Configuration_Node));
354

355 1
      Set_Str_To_Name_Buffer ("RequiredCores");
356 1
      P := Make_Defining_Identifier (Name_Find);
357 1
      Q := Make_Literal
358 1
        (XV.New_Numeric_Value (Get_Number_Of_Cores (E), 0, 10));
359

360 1
      Append_Node_To_List
361 1
        (Make_Assignement (P, Q),
362 1
         XTN.Items (AIR_Configuration_Node));
363

364 1
      Append_Node_To_List
365
        (AIR_Configuration_Node,
366 1
         XTN.Subitems (Current_XML_Node));
367

368 1
   end Map_AIR_Configuration_Node;
369

370
   ------------------------------
371
   -- Visit_Processor_Instance --
372
   ------------------------------
373

374 1
   procedure Visit_Processor_Instance (E : Node_Id) is
375
   begin
376 1
      Map_Air_Configuration_Node (E);
377 1
      Visit_Subcomponents_Of (E);
378 1
   end Visit_Processor_Instance;
379

380
end Ocarina.Backends.AIR_Conf.AIR_Configuration;

Read our documentation on viewing source code .

Loading