1
------------------------------------------------------------------------------
2
--                                                                          --
3
--                           OCARINA COMPONENTS                             --
4
--                                                                          --
5
--            OCARINA.BACKENDS.XTRATUM_CONF.SYSTEM_DESCRIPTION              --
6
--                                                                          --
7
--                                 B o d y                                  --
8
--                                                                          --
9
--         Copyright (C) 2011-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 Locations;
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_Values;
40
with Ocarina.Backends.XML_Tree.Nodes;
41
with Ocarina.Backends.XML_Tree.Nutils;
42
with Ocarina.Backends.Xtratum_Conf.Mapping;
43

44
package body Ocarina.Backends.Xtratum_Conf.System_Description is
45

46
   use Locations;
47
   use Ocarina.ME_AADL;
48
   use Ocarina.ME_AADL.AADL_Instances.Nodes;
49
   use Ocarina.ME_AADL.AADL_Instances.Entities;
50
   use Ocarina.Backends.Utils;
51
   use Ocarina.Backends.XML_Tree.Nutils;
52
   use Ocarina.Backends.Xtratum_Conf.Mapping;
53

54
   package AINU renames Ocarina.ME_AADL.AADL_Instances.Nutils;
55
   package AIN renames Ocarina.ME_AADL.AADL_Instances.Nodes;
56
   package XTN renames Ocarina.Backends.XML_Tree.Nodes;
57
   package XV renames Ocarina.Backends.XML_Values;
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_Virtual_Processor_Instance (E : Node_Id);
65
   procedure Visit_Subcomponents_Of is new Visit_Subcomponents_Of_G (Visit);
66

67
   Partition_Identifier : Unsigned_Long_Long := 0;
68

69
   -----------
70
   -- Visit --
71
   -----------
72

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

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

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

87
   ---------------------------------
88
   -- Visit_Architecture_Instance --
89
   ---------------------------------
90

91 1
   procedure Visit_Architecture_Instance (E : Node_Id) is
92
   begin
93 1
      Visit (Root_System (E));
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 1
         when CC_Virtual_Processor =>
114 1
            Visit_Virtual_Processor_Instance (E);
115

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

121
   ----------------------------
122
   -- Visit_Process_Instance --
123
   ----------------------------
124

125 0
   procedure Visit_Process_Instance (E : Node_Id) is
126
   begin
127 0
      Visit_Subcomponents_Of (E);
128 0
   end Visit_Process_Instance;
129

130
   ---------------------------
131
   -- Visit_System_Instance --
132
   ---------------------------
133

134 1
   procedure Visit_System_Instance (E : Node_Id) is
135 1
      S         : Node_Id;
136 1
      P         : Node_Id;
137 1
      U         : Node_Id;
138 1
      N         : Node_Id;
139 1
      Processes : List_Id;
140
   begin
141 1
      P := Map_HI_Node (E);
142 1
      Push_Entity (P);
143

144 1
      U := Map_HI_Unit (E);
145 1
      Push_Entity (U);
146

147 1
      if not AINU.Is_Empty (Subcomponents (E)) then
148 1
         S := First_Node (Subcomponents (E));
149 1
         while Present (S) loop
150
            --  Visit processor subcomponents
151

152 1
            if AINU.Is_Processor (Corresponding_Instance (S)) then
153 1
               Visit (Corresponding_Instance (S));
154
            end if;
155 1
            S := Next_Node (S);
156 1
         end loop;
157
      end if;
158 1
      N := New_Node (XTN.K_HI_Tree_Bindings);
159

160 1
      Processes := AINU.New_List (K_Node_Id, No_Location);
161

162 1
      XTN.Set_Processes (N, Processes);
163

164 1
      XTN.Set_Unit (N, U);
165 1
      XTN.Set_Node (N, P);
166

167 1
      AIN.Set_Backend_Node (Identifier (E), N);
168

169 1
      Pop_Entity;
170 1
      Pop_Entity;
171 1
   end Visit_System_Instance;
172

173
   ------------------------------
174
   -- Visit_Processor_Instance --
175
   ------------------------------
176

177 1
   procedure Visit_Processor_Instance (E : Node_Id) is
178 1
      N         : Node_Id;
179 1
      Processes : List_Id;
180
   begin
181 1
      Visit_Subcomponents_Of (E);
182

183 1
      N := New_Node (XTN.K_HI_Tree_Bindings);
184

185 1
      Processes := AINU.New_List (K_Node_Id, No_Location);
186

187 1
      XTN.Set_Processes (N, Processes);
188

189 1
      AIN.Set_Backend_Node (Identifier (E), N);
190 1
   end Visit_Processor_Instance;
191

192
   --------------------------------------
193
   -- Visit_Virtual_Processor_Instance --
194
   --------------------------------------
195

196 1
   procedure Visit_Virtual_Processor_Instance (E : Node_Id) is
197 1
      Partition_Identifier_Node : Node_Id;
198
   begin
199
      Partition_Identifier_Node :=
200 1
        Make_Literal (XV.New_Numeric_Value (Partition_Identifier, 1, 10));
201

202 1
      AIN.Set_Backend_Node (Identifier (E), Partition_Identifier_Node);
203

204 1
      Visit_Subcomponents_Of (E);
205

206 1
      Partition_Identifier := Partition_Identifier + 1;
207 1
   end Visit_Virtual_Processor_Instance;
208

209
end Ocarina.Backends.Xtratum_Conf.System_Description;

Read our documentation on viewing source code .

Loading