1
------------------------------------------------------------------------------
2
--                                                                          --
3
--                           OCARINA COMPONENTS                             --
4
--                                                                          --
5
--                OCARINA.BACKENDS.VXWORKS653_CONF.PAYLOADS                 --
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 Ocarina.Namet; use Ocarina.Namet;
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.XML_Tree.Nodes;
39
with Ocarina.Backends.XML_Tree.Nutils;
40
with Ocarina.Backends.Vxworks653_Conf.Mapping;
41
with Ocarina.Backends.Utils;
42

43
package body Ocarina.Backends.Vxworks653_Conf.Payloads is
44

45
   use Ocarina.ME_AADL;
46

47
   use Ocarina.ME_AADL.AADL_Instances.Nodes;
48
   use Ocarina.ME_AADL.AADL_Instances.Entities;
49
   use Ocarina.Backends.XML_Tree.Nutils;
50

51
   use Ocarina.Backends.Vxworks653_Conf.Mapping;
52
   use Ocarina.Backends.Utils;
53

54
   package AINU renames Ocarina.ME_AADL.AADL_Instances.Nutils;
55
   package XTN renames Ocarina.Backends.XML_Tree.Nodes;
56

57
   Root_Node : Node_Id := No_Node;
58

59
   procedure Visit_Architecture_Instance (E : Node_Id);
60
   procedure Visit_Component_Instance (E : Node_Id);
61
   procedure Visit_System_Instance (E : Node_Id);
62
   procedure Visit_Process_Instance (E : Node_Id);
63
   procedure Visit_Processor_Instance (E : Node_Id);
64
   procedure Visit_Bus_Instance (E : Node_Id);
65
   procedure Visit_Virtual_Processor_Instance (E : Node_Id);
66
   procedure Visit_Subcomponents_Of is new Visit_Subcomponents_Of_G (Visit);
67

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

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

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

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

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

90 1
   procedure Visit_Architecture_Instance (E : Node_Id) is
91
   begin
92 1
      Root_Node := Root_System (E);
93 1
      Visit (Root_Node);
94 1
   end Visit_Architecture_Instance;
95

96
   ------------------------------
97
   -- Visit_Component_Instance --
98
   ------------------------------
99

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

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

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

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

116 0
         when CC_Virtual_Processor =>
117 0
            Visit_Virtual_Processor_Instance (E);
118

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

124
   ----------------------------
125
   -- Visit_Process_Instance --
126
   ----------------------------
127

128 0
   procedure Visit_Process_Instance (E : Node_Id) is
129
   begin
130 0
      Visit_Subcomponents_Of (E);
131 0
   end Visit_Process_Instance;
132

133
   ---------------------------
134
   -- Visit_System_Instance --
135
   ---------------------------
136

137 1
   procedure Visit_System_Instance (E : Node_Id) is
138 1
      S : Node_Id;
139
   begin
140 1
      if not AINU.Is_Empty (Subcomponents (E)) then
141 1
         S := First_Node (Subcomponents (E));
142 1
         while Present (S) loop
143
            --  Visit processor subcomponents
144

145 1
            if AINU.Is_Processor (Corresponding_Instance (S)) then
146 1
               Visit (Corresponding_Instance (S));
147
            end if;
148 1
            S := Next_Node (S);
149 1
         end loop;
150
      end if;
151 1
   end Visit_System_Instance;
152

153
   ------------------------
154
   -- Visit_Bus_Instance --
155
   ------------------------
156

157 0
   procedure Visit_Bus_Instance (E : Node_Id) is
158
      pragma Unreferenced (E);
159
   begin
160 0
      null;
161 0
   end Visit_Bus_Instance;
162

163
   ------------------------------
164
   -- Visit_Processor_Instance --
165
   ------------------------------
166

167 1
   procedure Visit_Processor_Instance (E : Node_Id) is
168 1
      U                           : Node_Id;
169 1
      P                           : Node_Id;
170 1
      S                           : Node_Id;
171 1
      Payloads_Node               : Node_Id;
172 1
      Core_OS_Payload_Node        : Node_Id;
173 1
      Shared_Library_Payload_Node : Node_Id;
174 1
      Config_Record_Payload_Node  : Node_Id;
175 1
      Partition_Payload_Node      : Node_Id;
176
   begin
177 1
      U := XTN.Unit (Backend_Node (Identifier (E)));
178 1
      P := XTN.Node (Backend_Node (Identifier (E)));
179

180 1
      Push_Entity (P);
181 1
      Push_Entity (U);
182

183 1
      Current_XML_Node := XTN.Root_Node (XTN.XML_File (U));
184

185 1
      Payloads_Node := Make_XML_Node ("Payloads");
186

187 1
      Append_Node_To_List (Payloads_Node, XTN.Subitems (Current_XML_Node));
188

189 1
      Core_OS_Payload_Node := Make_XML_Node ("CoreOSPayload");
190 1
      Append_Node_To_List (Core_OS_Payload_Node, XTN.Subitems (Payloads_Node));
191

192 1
      Shared_Library_Payload_Node := Make_XML_Node ("SharedLibraryPayload");
193 1
      Add_Attribute ("NameRef", "vxSysLib", Shared_Library_Payload_Node);
194 1
      Append_Node_To_List
195
        (Shared_Library_Payload_Node,
196 1
         XTN.Subitems (Payloads_Node));
197

198 1
      Config_Record_Payload_Node := Make_XML_Node ("ConfigRecordPayload");
199 1
      Add_Attribute ("NameRef", "configRecord", Config_Record_Payload_Node);
200 1
      Append_Node_To_List
201
        (Config_Record_Payload_Node,
202 1
         XTN.Subitems (Payloads_Node));
203

204 1
      if not AINU.Is_Empty (Subcomponents (E)) then
205 1
         S := First_Node (Subcomponents (E));
206

207 1
         while Present (S) loop
208 1
            if AINU.Is_Virtual_Processor (Corresponding_Instance (S)) then
209 1
               Partition_Payload_Node := Make_XML_Node ("PartitionPayload");
210 1
               Add_Attribute
211
                 ("NameRef",
212 1
                  Get_Name_String
213 1
                    (Map_Partition_Name (Corresponding_Instance (S))),
214
                  Partition_Payload_Node);
215 1
               Append_Node_To_List
216
                 (Partition_Payload_Node,
217 1
                  XTN.Subitems (Payloads_Node));
218
            end if;
219 1
            S := Next_Node (S);
220 1
         end loop;
221
      end if;
222

223 1
      Pop_Entity;
224 1
      Pop_Entity;
225 1
   end Visit_Processor_Instance;
226

227
   --------------------------------------
228
   -- Visit_Virtual_Processor_Instance --
229
   --------------------------------------
230

231 0
   procedure Visit_Virtual_Processor_Instance (E : Node_Id) is
232
      pragma Unreferenced (E);
233
   begin
234 0
      null;
235 0
   end Visit_Virtual_Processor_Instance;
236

237
end Ocarina.Backends.Vxworks653_Conf.Payloads;

Read our documentation on viewing source code .

Loading