ocarina-backends-boundt.adb 11.6 KB
Newer Older
1
2
3
4
5
6
7
8
------------------------------------------------------------------------------
--                                                                          --
--                           OCARINA COMPONENTS                             --
--                                                                          --
--              O C A R I N A . B A C K E N D S . B O U N D T               --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
--    Copyright (C) 2008-2009 Telecom ParisTech, 2010-2015 ESA & ISAE.      --
--                                                                          --
-- Ocarina  is free software; you can redistribute it and/or modify under   --
-- terms of the  GNU General Public License as published  by the Free Soft- --
-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
-- sion. Ocarina is distributed in the hope that it will be useful, but     --
-- WITHOUT ANY WARRANTY; without even the implied warranty of               --
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                     --
--                                                                          --
-- As a special exception under Section 7 of GPL version 3, you are granted --
-- additional permissions described in the GCC Runtime Library Exception,   --
-- version 3.1, as published by the Free Software Foundation.               --
--                                                                          --
-- You should have received a copy of the GNU General Public License and    --
-- a copy of the GCC Runtime Library Exception along with this program;     --
-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
-- <http://www.gnu.org/licenses/>.                                          --
26
--                                                                          --
jhugues's avatar
jhugues committed
27
28
--                 Ocarina is maintained by the TASTE project               --
--                      (taste-users@lists.tuxfamily.org)                   --
29
30
31
--                                                                          --
------------------------------------------------------------------------------

32
with Ocarina.Namet;
33
34
35
36
37
with Ocarina.Backends.Messages;
with Ocarina.ME_AADL;
with Ocarina.ME_AADL.AADL_Instances.Nodes;
with Ocarina.ME_AADL.AADL_Tree.Nodes;
with Ocarina.ME_AADL.AADL_Instances.Nutils;
38
with Ocarina.Instances;           use Ocarina.Instances;
39
40
with Ocarina.ME_AADL.AADL_Instances.Entities;
with Ocarina.Backends.Properties; use Ocarina.Backends.Properties;
41
with Ocarina.Options;             use Ocarina.Options;
42

yoogx's avatar
yoogx committed
43
with Utils; use Utils;
44
45
46
47
48
49
50
51
52

with Ada.Text_IO;
with GNAT.IO_Aux;

package body Ocarina.Backends.BoundT is

   package ATN renames Ocarina.ME_AADL.AADL_Tree.Nodes;
   package AIN renames Ocarina.ME_AADL.AADL_Instances.Nodes;

53
   use Ocarina.Namet;
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
   use Ocarina.Backends.Messages;
   use Ada.Text_IO;
   use Ocarina.ME_AADL;
   use AIN;
   use Ocarina.ME_AADL.AADL_Instances.Nutils;

   procedure Visit (E : Node_Id);

   procedure Visit_Architecture_Instance (E : Node_Id);

   procedure Visit_Component_Instance (E : Node_Id);

   procedure Visit_System_Instance (E : Node_Id);

   procedure Visit_Process_Instance (E : Node_Id);

   procedure Visit_Thread_Instance (E : Node_Id);

   FD            : File_Type;
   Assertions_FD : File_Type;

   P_Model_Name            : Name_Id := No_Name;
   Current_Thread_Instance : Name_Id := No_Name;

   -----------
   -- Visit --
   -----------

   procedure Visit (E : Node_Id) is
   begin
      case Kind (E) is
         when K_Architecture_Instance =>
            Visit_Architecture_Instance (E);

         when K_Component_Instance =>
            Visit_Component_Instance (E);

         when others =>
            null;
      end case;
   end Visit;

   ---------------------------------
   -- Visit_Architecture_Instance --
   ---------------------------------

   procedure Visit_Architecture_Instance (E : Node_Id) is
   begin
      Visit (Root_System (E));
   end Visit_Architecture_Instance;

   ------------------------------
   -- Visit_Component_Instance --
   ------------------------------

   procedure Visit_Component_Instance (E : Node_Id) is
      use Ocarina.ME_AADL.AADL_Instances.Entities;

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

         when CC_Process =>
119
120
121
122
123
124
            if Boundt_Process = No_Name
              or else
                To_Lower
                  (AIN.Name (AIN.Identifier (AIN.Parent_Subcomponent (E)))) =
                Boundt_Process
            then
125
126
               Visit_Process_Instance (E);
            end if;
yoogx's avatar
yoogx committed
127

128
129
130
131
132
133
134
135
136
137
138
139
140
141
         when CC_Thread =>
            Visit_Thread_Instance (E);

         when others =>
            null;
      end case;
   end Visit_Component_Instance;

   ---------------------------
   -- Visit_Thread_Instance --
   ---------------------------

   procedure Visit_Thread_Instance (E : Node_Id) is
      Raw_Name : constant String :=
142
143
144
145
        String'
          (Get_Name_String (P_Model_Name) &
           "_" &
           Get_Name_String (Current_Thread_Instance));
146
      Base_Name : constant String :=
147
148
149
150
        String'
          ("polyorb_hi_generated__activity__" &
           Get_Name_String (Current_Thread_Instance));
      Procedure_Name  : constant String := String'(Base_Name & "_job");
151
152
      Assertion_Basis : constant String :=
        String'(Base_Name & "_interrogators");
153
      Assertion_Send : constant String :=
154
        String'(Assertion_Basis & "__send_outputXn");
155
      Assertion_Get : constant String :=
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
        String'(Assertion_Basis & "__get_valueXn");

      T_Dispatch_Protocol : Supported_Thread_Dispatch_Protocol;
      Modes_Nb            : Int;
   begin
      Put_Line (FD, "");
      Put_Line (FD, "  thread " & Raw_Name);

      T_Dispatch_Protocol := Get_Thread_Dispatch_Protocol (E);
      case T_Dispatch_Protocol is
         when Thread_Periodic =>
            Put_Line (FD, "    type cyclic");
         when Thread_Sporadic =>
            Put_Line (FD, "    type sporadic");
         when Thread_Hybrid =>
            --  In PolyORB-HI, an hybrid thread is really a sporadic
            --  thread that receives a period_event every periods
            Put_Line (FD, "    type sporadic");
         when others =>
            raise Program_Error;
      end case;

      --  We can guess the related top subprogram
      --  name simply by adding "_job" the the thread
      --  raw name

      Put_Line (FD, "    root " & Procedure_Name);
      Put_Line (FD, "  end " & Raw_Name);

      --  PolyORB-HI generates unbounded subprograms

187
      Put_Line (Assertions_FD, "subprogram """ & Assertion_Send & """");
188
189
190
191
      Put_Line (Assertions_FD, "    time 0 cycles;");
      Put_Line (Assertions_FD, "end;");
      Put_Line (Assertions_FD, "");

192
      Put_Line (Assertions_FD, "subprogram """ & Assertion_Get & """");
193
194
195
196
197
198
199
200
201
202
203
204
      Put_Line (Assertions_FD, "    time 0 cycles;");
      Put_Line (Assertions_FD, "end;");
      Put_Line (Assertions_FD, "");

      --  If their is modes in the generated thread, then a while loop
      --  is generated. We can bound this loop by the number of modes
      --  defined in the thread

      if not Is_Empty (Modes (E)) then

         Modes_Nb := Int (Length (Modes (E)));

205
206
207
208
209
210
         Put_Line (Assertions_FD, "subprogram """ & Procedure_Name & """");
         Put_Line
           (Assertions_FD,
            "    all loops repeats " &
            Int'Image (Modes_Nb) &
            " times; end loops;");
211
212
213
214
215
216
217
218
219
220
221
222
223
         Put_Line (Assertions_FD, "end;");
         Put_Line (Assertions_FD, "");
      end if;

   end Visit_Thread_Instance;

   ----------------------------
   -- Visit_Process_Instance --
   ----------------------------

   procedure Visit_Process_Instance (E : Node_Id) is
      T : Node_Id;
   begin
224
225
226
227
      P_Model_Name :=
        ATN.Name
          (ATN.Identifier
             (Corresponding_Declaration (Parent_Subcomponent (E))));
228

229
      Put_Line (FD, "program " & Get_Name_String (P_Model_Name));
230
231
232
233
234
235
236
237
238

      --  Then we parse all threads which are subcomponent
      --  of the process

      T := First_Node (Subcomponents (E));
      while Present (T) loop

         case AADL_Version is
            when AADL_V1 =>
239
240
               Current_Thread_Instance :=
                 ATN.Name (ATN.Identifier (Corresponding_Declaration (T)));
241
242

            when AADL_V2 =>
243
244
245
246
247
248
249
250
251
252
253
254
               Current_Thread_Instance :=
                 Get_String_Name
                   (Get_Name_String
                      (To_Lower
                         (AIN.Name
                            (AIN.Identifier
                               (AIN.Namespace
                                  (AIN.Corresponding_Instance (T)))))) &
                    "_" &
                    Get_Name_String
                      (ATN.Name
                         (ATN.Identifier (Corresponding_Declaration (T)))));
255
         end case;
256
         Visit (Corresponding_Instance (T));
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273

         T := Next_Node (T);
      end loop;

      Put_Line (FD, "end " & Get_Name_String (P_Model_Name));
   end Visit_Process_Instance;

   ---------------------------
   -- Visit_System_Instance --
   ---------------------------

   procedure Visit_System_Instance (E : Node_Id) is
      S : Node_Id;
   begin
      --  Visit all the subcomponents of the system

      if not Ocarina.ME_AADL.AADL_Instances.Nutils.Is_Empty
274
          (Subcomponents (E))
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
      then
         S := First_Node (Subcomponents (E));
         while Present (S) loop
            --  Visit the component instance corresponding to the
            --  subcomponent S.

            Visit (Corresponding_Instance (S));
            S := Next_Node (S);
         end loop;
      end if;
   end Visit_System_Instance;

   ----------
   -- Init --
   ----------

   procedure Init is
   begin
      Register_Backend ("boundt", Generate'Access, Bound_T);
   end Init;

   --------------
   -- Generate --
   --------------

   procedure Generate (AADL_Root : Node_Id) is
      Instance_Root : Node_Id;
302

303
304
305
306
307
308
309
310
311
312
313
314
315
   begin
      --  Instantiate the AADL tree

      Instance_Root := Instantiate_Model (AADL_Root);
      if No (Instance_Root) then
         raise Program_Error;
      end if;

      --  Open a new TPO file

      if Boundt_Process = No_Name then
         Create (File => FD, Name => "scenario.tpo");
      else
316
317
318
         Create
           (File => FD,
            Name => "scenario_" & Get_Name_String (Boundt_Process) & ".tpo");
319
320
321
322
323
324
      end if;

      --  Open the assertion template file
      if not GNAT.IO_Aux.File_Exists ("assertions.txt") then
         Display_Error
           ("No assertion file found, create a new one",
325
            Fatal   => False,
326
            Warning => True);
327
         Create (File => Assertions_FD, Name => "assertions.txt");
328
      else
329
330
331
332
         Open
           (File => Assertions_FD,
            Mode => Append_File,
            Name => "assertions.txt");
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
      end if;

      Put_Line (Assertions_FD, "");
      Put_Line (Assertions_FD, "--  Automatically generated assertions");
      Put_Line (Assertions_FD, "--  DO NOT EDIT !");
      Put_Line (Assertions_FD, "");

      --  Parse all the processes, each one will be an TPO program

      Visit_Architecture_Instance (Instance_Root);

      --  Close file descriptors

      Close (FD);
      Close (Assertions_FD);
   end Generate;

   -----------
   -- Reset --
   -----------

   procedure Reset is
   begin
356
      P_Model_Name            := No_Name;
357
358
359
360
      Current_Thread_Instance := No_Name;
   end Reset;

end Ocarina.Backends.BoundT;