1
------------------------------------------------------------------------------
2
--                                                                          --
3
--                           OCARINA COMPONENTS                             --
4
--                                                                          --
5
--                OCARINA.BACKENDS.ARINC653_CONF.PARTITIONS                 --
6
--                                                                          --
7
--                                 B o d y                                  --
8
--                                                                          --
9
--                  Copyright (C) 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 Ocarina.ME_AADL;
34
with Ocarina.ME_AADL.AADL_Instances.Nodes;
35
with Ocarina.ME_AADL.AADL_Instances.Nutils;
36
with Ocarina.ME_AADL.AADL_Instances.Entities;
37

38
with Ocarina.Backends.Utils;
39
with Ocarina.Backends.XML_Tree.Nodes;
40
with Ocarina.Backends.XML_Tree.Nutils;
41
with Ocarina.Backends.ARINC653_Conf.Mapping;
42

43 1
package body Ocarina.Backends.ARINC653_Conf.Partitions is
44

45
   use Ocarina.ME_AADL;
46
   use Ocarina.ME_AADL.AADL_Instances.Nodes;
47
   use Ocarina.ME_AADL.AADL_Instances.Entities;
48
   use Ocarina.Backends.Utils;
49
   use Ocarina.Backends.XML_Tree.Nutils;
50
   use Ocarina.Backends.ARINC653_Conf.Mapping;
51

52
   package AINU renames Ocarina.ME_AADL.AADL_Instances.Nutils;
53
   package XTN renames Ocarina.Backends.XML_Tree.Nodes;
54

55
   procedure Visit_Architecture_Instance (E : Node_Id);
56
   procedure Visit_Component_Instance (E : Node_Id);
57
   procedure Visit_System_Instance (E : Node_Id);
58
   procedure Visit_Process_Instance (E : Node_Id);
59
   procedure Visit_Processor_Instance (E : Node_Id);
60
   procedure Visit_Bus_Instance (E : Node_Id);
61
   procedure Visit_Virtual_Processor_Instance (E : Node_Id);
62
   procedure Visit_Data_Instance (E : Node_Id);
63

64
   System_Nb_Processes : Unsigned_Long_Long := 0;
65 1
   Current_Parent_Node : Node_Id;
66 1
   Process_Node        : Node_Id;
67

68
   -----------
69
   -- Visit --
70
   -----------
71

72 0
   procedure Visit (E : Node_Id) is
73
   begin
74 0
      case Kind (E) is
75 0
         when K_Architecture_Instance =>
76 0
            Visit_Architecture_Instance (E);
77

78 0
         when K_Component_Instance =>
79 0
            Visit_Component_Instance (E);
80

81 0
         when others =>
82 0
            null;
83 0
      end case;
84 0
   end Visit;
85

86
   ---------------------------------
87
   -- Visit_Architecture_Instance --
88
   ---------------------------------
89

90 0
   procedure Visit_Architecture_Instance (E : Node_Id) is
91
   begin
92 0
      Visit (Root_System (E));
93 0
   end Visit_Architecture_Instance;
94

95
   ------------------------------
96
   -- Visit_Component_Instance --
97
   ------------------------------
98

99 0
   procedure Visit_Component_Instance (E : Node_Id) is
100 0
      Category : constant Component_Category := Get_Category_Of_Component (E);
101
   begin
102 0
      case Category is
103 0
         when CC_System =>
104 0
            Visit_System_Instance (E);
105

106 0
         when CC_Process =>
107 0
            Visit_Process_Instance (E);
108

109 0
         when CC_Device =>
110 0
            Visit_Process_Instance (E);
111

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

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

118 0
         when CC_Data =>
119 0
            Visit_Data_Instance (E);
120

121 0
         when CC_Virtual_Processor =>
122 0
            Visit_Virtual_Processor_Instance (E);
123

124 0
         when others =>
125 0
            null;
126 0
      end case;
127 0
   end Visit_Component_Instance;
128

129
   ----------------------------
130
   -- Visit_Process_Instance --
131
   ----------------------------
132

133 0
   procedure Visit_Process_Instance (E : Node_Id) is
134 0
      S                  : Node_Id;
135 0
      F                  : Node_Id;
136 0
      Old_Current_Parent : Node_Id;
137
   begin
138 0
      System_Nb_Processes := System_Nb_Processes + 1;
139

140
      --  Create the main node and set its name as an item
141 0
      Process_Node := Map_Process (E, System_Nb_Processes);
142

143
      --  Look for a possible bounded virtual processor/processor
144
      --  N := Get_Bound_Processor (E);
145

146 0
      Old_Current_Parent  := Current_Parent_Node;
147 0
      Current_Parent_Node := Process_Node;
148

149 0
      if not AINU.Is_Empty (Subcomponents (E)) then
150 0
         S := First_Node (Subcomponents (E));
151 0
         while Present (S) loop
152
            --  Visit the component instance corresponding to the
153
            --  subcomponent S.
154

155 0
            Visit (Corresponding_Instance (S));
156 0
            S := Next_Node (S);
157 0
         end loop;
158
      end if;
159

160 0
      if Has_Ports (E) then
161 0
         F := First_Node (Features (E));
162

163 0
         while Present (F) loop
164 0
            if Kind (F) = K_Port_Spec_Instance
165 0
              and then Get_Connection_Pattern (F) = Inter_Process
166
            then
167 0
               Append_Node_To_List (Map_Port (F), XTN.Subitems (Process_Node));
168
            end if;
169 0
            F := Next_Node (F);
170 0
         end loop;
171
      end if;
172

173 0
      Current_Parent_Node := Old_Current_Parent;
174

175 0
      Append_Node_To_List (Process_Node, XTN.Subitems (Current_Parent_Node));
176

177 0
   end Visit_Process_Instance;
178

179
   -------------------------
180
   -- Visit_Data_Instance --
181
   -------------------------
182

183 0
   procedure Visit_Data_Instance (E : Node_Id) is
184 0
      N : Node_Id;
185
   begin
186 0
      N := Map_Data (E);
187 0
      Append_Node_To_List (N, XTN.Subitems (Current_Parent_Node));
188 0
   end Visit_Data_Instance;
189

190
   ---------------------------
191
   -- Visit_System_Instance --
192
   ---------------------------
193

194 0
   procedure Visit_System_Instance (E : Node_Id) is
195 0
      S : Node_Id;
196
   begin
197 0
      if not AINU.Is_Empty (Subcomponents (E)) then
198 0
         S := First_Node (Subcomponents (E));
199 0
         while Present (S) loop
200
            --  Visit the component instance corresponding to the
201
            --  subcomponent S.
202 0
            if AINU.Is_Processor (Corresponding_Instance (S)) then
203 0
               Visit (Corresponding_Instance (S));
204
            end if;
205 0
            S := Next_Node (S);
206 0
         end loop;
207
      end if;
208

209 0
   end Visit_System_Instance;
210

211
   ------------------------
212
   -- Visit_Bus_Instance --
213
   ------------------------
214

215 0
   procedure Visit_Bus_Instance (E : Node_Id) is
216 0
      S : Node_Id;
217 0
      N : Node_Id;
218 0
      O : Node_Id;
219
   begin
220
      --  Create the main node and set its name as an item
221 0
      N                   := Map_Bus (E);
222 0
      O                   := Current_Parent_Node;
223 0
      Current_Parent_Node := N;
224 0
      if not AINU.Is_Empty (Subcomponents (E)) then
225 0
         S := First_Node (Subcomponents (E));
226 0
         while Present (S) loop
227
            --  Visit the component instance corresponding to the
228
            --  subcomponent S.
229

230 0
            Visit (Corresponding_Instance (S));
231 0
            S := Next_Node (S);
232 0
         end loop;
233
      end if;
234 0
      Current_Parent_Node := O;
235

236 0
      Append_Node_To_List (N, XTN.Subitems (Current_Parent_Node));
237

238 0
   end Visit_Bus_Instance;
239

240
   ------------------------------
241
   -- Visit_Processor_Instance --
242
   ------------------------------
243

244 0
   procedure Visit_Processor_Instance (E : Node_Id) is
245 0
      S : Node_Id;
246 0
      U : Node_Id;
247 0
      P : Node_Id;
248
   begin
249 0
      System_Nb_Processes := 0;
250 0
      U                   := XTN.Unit (Backend_Node (Identifier (E)));
251 0
      P                   := XTN.Node (Backend_Node (Identifier (E)));
252

253 0
      Push_Entity (U);
254 0
      Push_Entity (P);
255

256 0
      Current_XML_Node := XTN.Root_Node (XTN.XML_File (U));
257

258 0
      Current_Parent_Node := Current_XML_Node;
259

260 0
      if not AINU.Is_Empty (Subcomponents (E)) then
261 0
         S := First_Node (Subcomponents (E));
262 0
         while Present (S) loop
263
            --  Visit the component instance corresponding to the
264
            --  subcomponent S.
265

266 0
            Visit (Corresponding_Instance (S));
267 0
            S := Next_Node (S);
268 0
         end loop;
269
      end if;
270

271 0
      Pop_Entity;
272 0
      Pop_Entity;
273 0
   end Visit_Processor_Instance;
274

275
   --------------------------------------
276
   -- Visit_Virtual_Processor_Instance --
277
   --------------------------------------
278

279 0
   procedure Visit_Virtual_Processor_Instance (E : Node_Id) is
280 0
      S         : Node_Id;
281 0
      Processes : List_Id;
282
   begin
283 0
      if not AINU.Is_Empty (Subcomponents (E)) then
284 0
         S := First_Node (Subcomponents (E));
285 0
         while Present (S) loop
286
            --  Visit the component instance corresponding to the
287
            --  subcomponent S.
288

289 0
            Visit (Corresponding_Instance (S));
290 0
            S := Next_Node (S);
291 0
         end loop;
292
      end if;
293

294 0
      if Present (Backend_Node (Identifier (E))) then
295 0
         Processes := XTN.Processes (Backend_Node (Identifier (E)));
296 0
         S         := XTN.First_Node (Processes);
297 0
         while Present (S) loop
298 0
            Visit (XTN.Content (S));
299 0
            S := XTN.Next_Node (S);
300 0
         end loop;
301
      end if;
302 0
   end Visit_Virtual_Processor_Instance;
303

304 1
end Ocarina.Backends.ARINC653_Conf.Partitions;

Read our documentation on viewing source code .

Loading