OpenAADL / ocarina
1
------------------------------------------------------------------------------
2
--                                                                          --
3
--                           OCARINA COMPONENTS                             --
4
--                                                                          --
5
--              OCARINA.BACKENDS.VXWORKS653_CONF.CONNECTIONS                --
6
--                                                                          --
7
--                                 B o d y                                  --
8
--                                                                          --
9
--         Copyright (C) 2015-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 Ada.Strings;       use Ada.Strings;
33
with Ada.Strings.Fixed; use Ada.Strings.Fixed;
34

35
with Ocarina.Backends.Utils;
36
with Ocarina.Namet; use Ocarina.Namet;
37
with Ocarina.ME_AADL;
38
with Ocarina.ME_AADL.AADL_Instances.Nodes;
39
with Ocarina.ME_AADL.AADL_Instances.Nutils;
40
with Ocarina.ME_AADL.AADL_Instances.Entities;
41

42
with Ocarina.Backends.C_Common.Mapping;
43
with Ocarina.Backends.XML_Tree.Nodes;
44
with Ocarina.Backends.XML_Tree.Nutils;
45
with Ocarina.Backends.Vxworks653_Conf.Mapping;
46

47
package body Ocarina.Backends.Vxworks653_Conf.Connections is
48

49
   use Ocarina.ME_AADL;
50
   use Ocarina.Backends.Utils;
51

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

56
   use Ocarina.Backends.Vxworks653_Conf.Mapping;
57

58
   package AINU renames Ocarina.ME_AADL.AADL_Instances.Nutils;
59
   package XTN renames Ocarina.Backends.XML_Tree.Nodes;
60

61
   Root_Node          : Node_Id            := No_Node;
62
   Connections_Node   : Node_Id            := No_Node;
63
   Channel_Identifier : Unsigned_Long_Long := 0;
64

65
   procedure Visit_Architecture_Instance (E : Node_Id);
66
   procedure Visit_Component_Instance (E : Node_Id);
67
   procedure Visit_System_Instance (E : Node_Id);
68
   procedure Visit_Processor_Instance (E : Node_Id);
69
   procedure Visit_Bus_Instance (E : Node_Id);
70
   procedure Visit_Virtual_Processor_Instance (E : Node_Id);
71

72
   -----------
73
   -- Visit --
74
   -----------
75

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

82 1
         when K_Component_Instance =>
83 1
            Visit_Component_Instance (E);
84

85 0
         when others =>
86 0
            null;
87 1
      end case;
88 1
   end Visit;
89

90
   ---------------------------------
91
   -- Visit_Architecture_Instance --
92
   ---------------------------------
93

94 1
   procedure Visit_Architecture_Instance (E : Node_Id) is
95
   begin
96 1
      Root_Node := Root_System (E);
97 1
      Visit (Root_Node);
98 1
   end Visit_Architecture_Instance;
99

100
   ------------------------------
101
   -- Visit_Component_Instance --
102
   ------------------------------
103

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

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

114 0
         when CC_Bus =>
115 0
            Visit_Bus_Instance (E);
116

117 1
         when CC_Virtual_Processor =>
118 1
            Visit_Virtual_Processor_Instance (E);
119

120 0
         when others =>
121 0
            null;
122 1
      end case;
123 1
   end Visit_Component_Instance;
124

125
   ---------------------------
126
   -- Visit_System_Instance --
127
   ---------------------------
128

129 1
   procedure Visit_System_Instance (E : Node_Id) is
130 1
      S : Node_Id;
131
   begin
132 1
      if not AINU.Is_Empty (Subcomponents (E)) then
133 1
         S := First_Node (Subcomponents (E));
134 1
         while Present (S) loop
135
            --  Visit processor subcomponents
136

137 1
            if AINU.Is_Processor (Corresponding_Instance (S)) then
138 1
               Visit (Corresponding_Instance (S));
139
            end if;
140 1
            S := Next_Node (S);
141 1
         end loop;
142
      end if;
143 1
   end Visit_System_Instance;
144

145
   ------------------------
146
   -- Visit_Bus_Instance --
147
   ------------------------
148

149 0
   procedure Visit_Bus_Instance (E : Node_Id) is
150
      pragma Unreferenced (E);
151
   begin
152 0
      null;
153 0
   end Visit_Bus_Instance;
154

155
   ------------------------------
156
   -- Visit_Processor_Instance --
157
   ------------------------------
158

159 1
   procedure Visit_Processor_Instance (E : Node_Id) is
160 1
      U : Node_Id;
161 1
      P : Node_Id;
162 1
      S : Node_Id;
163
   begin
164 1
      U := XTN.Unit (Backend_Node (Identifier (E)));
165 1
      P := XTN.Node (Backend_Node (Identifier (E)));
166

167 1
      Push_Entity (P);
168 1
      Push_Entity (U);
169

170 1
      Channel_Identifier := 0;
171

172 1
      Current_XML_Node := XTN.Root_Node (XTN.XML_File (U));
173

174 1
      Connections_Node := Make_XML_Node ("Connections");
175

176 1
      if not AINU.Is_Empty (Subcomponents (E)) then
177 1
         S := First_Node (Subcomponents (E));
178 1
         while Present (S) loop
179
            --  Visit virtual processor subcomponents
180

181 1
            if AINU.Is_Virtual_Processor (Corresponding_Instance (S)) then
182 1
               Visit (Corresponding_Instance (S));
183
            end if;
184 1
            S := Next_Node (S);
185 1
         end loop;
186
      end if;
187

188 1
      Append_Node_To_List (Connections_Node, XTN.Subitems (Current_XML_Node));
189

190 1
      Pop_Entity;
191 1
      Pop_Entity;
192 1
   end Visit_Processor_Instance;
193

194
   --------------------------------------
195
   -- Visit_Virtual_Processor_Instance --
196
   --------------------------------------
197

198 1
   procedure Visit_Virtual_Processor_Instance (E : Node_Id) is
199 1
      Corresponding_Process : Node_Id;
200 1
      Channel_Node          : Node_Id;
201 1
      Source_Node           : Node_Id;
202 1
      Destination_Node      : Node_Id;
203 1
      Feature               : Node_Id;
204 1
      Port_Source           : Node_Id;
205 1
      Port_Destination      : Node_Id;
206 1
      Partition_Destination : Node_Id;
207
   begin
208 1
      Corresponding_Process := Find_Associated_Process (E);
209

210 1
      if AINU.Is_Empty (Features (Corresponding_Process)) then
211 0
         return;
212
      end if;
213

214 1
      Feature := First_Node (Features (Corresponding_Process));
215

216 1
      while Present (Feature) loop
217 1
         if Is_Data (Feature) and then Is_Out (Feature) then
218 1
            Port_Source           := Feature;
219 1
            Port_Destination := Item (First_Node (Destinations (Feature)));
220 1
            Partition_Destination := Parent_Component (Port_Destination);
221

222 1
            Channel_Node := Make_XML_Node ("Channel");
223 1
            Add_Attribute
224
              ("Id",
225 1
               Trim (Unsigned_Long_Long'Image (Channel_Identifier), Left),
226
               Channel_Node);
227

228 1
            Source_Node := Make_XML_Node ("Source");
229 1
            Add_Attribute
230
              ("PartitionNameRef",
231 1
               Get_Name_String (Map_Partition_Name (E)),
232
               Source_Node);
233

234 1
            Add_Attribute
235
              ("PortNameRef",
236 1
               Get_Name_String (C_Common.Mapping.Map_Port_Name (Port_Source)),
237
               Source_Node);
238

239 1
            Append_Node_To_List (Source_Node, XTN.Subitems (Channel_Node));
240

241 1
            Destination_Node := Make_XML_Node ("Destination");
242 1
            Add_Attribute
243
              ("PortNameRef",
244 1
               Get_Name_String
245 1
                 (C_Common.Mapping.Map_Port_Name (Port_Destination)),
246
               Destination_Node);
247

248 1
            Add_Attribute
249
              ("PartitionNameRef",
250 1
               Get_Name_String
251 1
                 (Map_Partition_Name
252 1
                    (Get_Partition_Runtime (Partition_Destination))),
253
               Destination_Node);
254

255 1
            Append_Node_To_List
256
              (Destination_Node,
257 1
               XTN.Subitems (Channel_Node));
258 1
            Append_Node_To_List
259
              (Channel_Node,
260 1
               XTN.Subitems (Connections_Node));
261

262 1
            Channel_Identifier := Channel_Identifier + 1;
263
         end if;
264 1
         Feature := Next_Node (Feature);
265 1
      end loop;
266

267
   end Visit_Virtual_Processor_Instance;
268

269
end Ocarina.Backends.Vxworks653_Conf.Connections;

Read our documentation on viewing source code .

Loading