OpenAADL / ocarina
1
------------------------------------------------------------------------------
2
--                                                                          --
3
--                           OCARINA COMPONENTS                             --
4
--                                                                          --
5
--                OCARINA.BACKENDS.VXWORKS653_CONF.SCHEDULE                 --
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
with Ocarina.Instances.Queries;
38

39
with Ocarina.Backends.Properties.ARINC653;
40

41
--  with Ocarina.Backends.Properties;
42
with Ocarina.Backends.XML_Values;
43
with Ocarina.Backends.Utils;
44
with Ocarina.Backends.XML_Tree.Nodes;
45
with Ocarina.Backends.XML_Tree.Nutils;
46
with Ocarina.ME_AADL.AADL_Tree.Nodes;
47

48
package body Ocarina.Backends.Vxworks653_Conf.Schedule is
49

50
   use Ocarina.ME_AADL;
51

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

57
   use Ocarina.Backends.Utils;
58
   use Ocarina.Backends.Properties.ARINC653;
59

60
   package ATN renames Ocarina.ME_AADL.AADL_Tree.Nodes;
61
   package AINU renames Ocarina.ME_AADL.AADL_Instances.Nutils;
62
   package XTN renames Ocarina.Backends.XML_Tree.Nodes;
63
   package XTU renames Ocarina.Backends.XML_Tree.Nutils;
64
   package XV renames Ocarina.Backends.XML_Values;
65

66
   Root_Node      : Node_Id := No_Node;
67
   Schedules_Node : Node_Id := No_Node;
68

69
   procedure Visit_Architecture_Instance (E : Node_Id);
70
   procedure Visit_Component_Instance (E : Node_Id);
71
   procedure Visit_System_Instance (E : Node_Id);
72
   procedure Visit_Process_Instance (E : Node_Id);
73
   procedure Visit_Processor_Instance (E : Node_Id);
74
   procedure Visit_Bus_Instance (E : Node_Id);
75
   procedure Visit_Virtual_Processor_Instance (E : Node_Id);
76
   procedure Visit_Subcomponents_Of is new Visit_Subcomponents_Of_G (Visit);
77

78
   procedure Fill_Scheduling_Slots (Processor : Node_Id);
79

80
   -----------
81
   -- Visit --
82
   -----------
83

84 1
   procedure Visit (E : Node_Id) is
85
   begin
86 1
      case Kind (E) is
87 1
         when K_Architecture_Instance =>
88 1
            Visit_Architecture_Instance (E);
89

90 1
         when K_Component_Instance =>
91 1
            Visit_Component_Instance (E);
92

93 0
         when others =>
94 0
            null;
95 1
      end case;
96 1
   end Visit;
97

98
   ---------------------------------
99
   -- Visit_Architecture_Instance --
100
   ---------------------------------
101

102 1
   procedure Visit_Architecture_Instance (E : Node_Id) is
103
   begin
104 1
      Root_Node := Root_System (E);
105 1
      Visit (Root_Node);
106 1
   end Visit_Architecture_Instance;
107

108
   ------------------------------
109
   -- Visit_Component_Instance --
110
   ------------------------------
111

112 1
   procedure Visit_Component_Instance (E : Node_Id) is
113 1
      Category : constant Component_Category := Get_Category_Of_Component (E);
114
   begin
115 1
      case Category is
116 1
         when CC_System =>
117 1
            Visit_System_Instance (E);
118

119 0
         when CC_Process =>
120 0
            Visit_Process_Instance (E);
121

122 1
         when CC_Processor =>
123 1
            Visit_Processor_Instance (E);
124

125 0
         when CC_Bus =>
126 0
            Visit_Bus_Instance (E);
127

128 1
         when CC_Virtual_Processor =>
129 1
            Visit_Virtual_Processor_Instance (E);
130

131 0
         when others =>
132 0
            null;
133 1
      end case;
134 1
   end Visit_Component_Instance;
135

136
   ----------------------------
137
   -- Visit_Process_Instance --
138
   ----------------------------
139

140 0
   procedure Visit_Process_Instance (E : Node_Id) is
141
   begin
142 0
      Visit_Subcomponents_Of (E);
143 0
   end Visit_Process_Instance;
144

145
   ---------------------------
146
   -- Visit_System_Instance --
147
   ---------------------------
148

149 1
   procedure Visit_System_Instance (E : Node_Id) is
150 1
      S : Node_Id;
151
   begin
152 1
      if not AINU.Is_Empty (Subcomponents (E)) then
153 1
         S := First_Node (Subcomponents (E));
154 1
         while Present (S) loop
155
            --  Visit processor subcomponents
156

157 1
            if AINU.Is_Processor (Corresponding_Instance (S)) then
158 1
               Visit (Corresponding_Instance (S));
159
            end if;
160 1
            S := Next_Node (S);
161 1
         end loop;
162
      end if;
163 1
   end Visit_System_Instance;
164

165
   ------------------------
166
   -- Visit_Bus_Instance --
167
   ------------------------
168

169 0
   procedure Visit_Bus_Instance (E : Node_Id) is
170
      pragma Unreferenced (E);
171
   begin
172 0
      null;
173 0
   end Visit_Bus_Instance;
174

175
   ---------------------------
176
   -- Fill_Scheduling_Slots --
177
   ---------------------------
178

179 1
   procedure Fill_Scheduling_Slots (Processor : Node_Id) is
180 1
      Partition_Window_Node : Node_Id;
181 1
      Schedule_Node         : Node_Id;
182 1
      Module_Schedule       : constant Schedule_Window_Record_Term_Array :=
183 1
        Get_Module_Schedule_Property (Processor);
184 1
      Partition_Duration : Long_Double;
185
   begin
186 1
      Schedule_Node := Make_XML_Node ("Schedule");
187 1
      XTU.Add_Attribute ("Id", "0", Schedule_Node);
188 1
      Append_Node_To_List (Schedule_Node, XTN.Subitems (Schedules_Node));
189

190 1
      for J in Module_Schedule'Range loop
191 1
         Partition_Window_Node := Make_XML_Node ("PartitionWindow");
192

193 1
         Append_Node_To_List
194
           (Partition_Window_Node,
195 1
            XTN.Subitems (Schedule_Node));
196

197
         --  We assume the partition duration is in milliseconds
198

199 1
         Partition_Duration :=
200 1
           (Long_Double (To_Nanoseconds (Module_Schedule (J).Duration)) /
201
            Long_Double (1_000_000_000.0));
202 1
         XTU.Add_Attribute
203
           ("Duration",
204 1
            XV.New_Floating_Point_Value (Partition_Duration),
205
            Partition_Window_Node);
206 1
         XTU.Add_Attribute ("ReleasePoint", "1", Partition_Window_Node);
207 1
         XTU.Add_Attribute
208
           ("PartitionNameRef",
209 1
            Get_Name_String
210 1
              (ATN.Display_Name
211 1
                 (ATN.Identifier (Module_Schedule (J).Partition))),
212
            Partition_Window_Node);
213 1
      end loop;
214 1
   end Fill_Scheduling_Slots;
215

216
   ------------------------------
217
   -- Visit_Processor_Instance --
218
   ------------------------------
219

220 1
   procedure Visit_Processor_Instance (E : Node_Id) is
221 1
      S : Node_Id;
222 1
      U : Node_Id;
223 1
      P : Node_Id;
224
   begin
225 1
      U := XTN.Unit (Backend_Node (Identifier (E)));
226 1
      P := XTN.Node (Backend_Node (Identifier (E)));
227

228 1
      Push_Entity (P);
229 1
      Push_Entity (U);
230

231 1
      Current_XML_Node := XTN.Root_Node (XTN.XML_File (U));
232

233 1
      Schedules_Node := Make_XML_Node ("Schedules");
234

235 1
      Append_Node_To_List (Schedules_Node, XTN.Subitems (Current_XML_Node));
236

237 1
      if Is_Defined_Property (E, "arinc653::module_schedule") then
238 1
         Fill_Scheduling_Slots (E);
239
      end if;
240

241 1
      if not AINU.Is_Empty (Subcomponents (E)) then
242 1
         S := First_Node (Subcomponents (E));
243 1
         while Present (S) loop
244
            --  Visit virtual processor subcomponents
245

246 1
            if AINU.Is_Virtual_Processor (Corresponding_Instance (S)) then
247 1
               Visit (Corresponding_Instance (S));
248
            end if;
249 1
            S := Next_Node (S);
250 1
         end loop;
251
      end if;
252

253 1
      Pop_Entity;
254 1
      Pop_Entity;
255 1
   end Visit_Processor_Instance;
256

257
   --------------------------------------
258
   -- Visit_Virtual_Processor_Instance --
259
   --------------------------------------
260

261 1
   procedure Visit_Virtual_Processor_Instance (E : Node_Id) is
262
      pragma Unreferenced (E);
263
   begin
264 1
      null;
265 1
   end Visit_Virtual_Processor_Instance;
266

267
end Ocarina.Backends.Vxworks653_Conf.Schedule;

Read our documentation on viewing source code .

Loading