taste-concurrency_view.adb 11.9 KB
Newer Older
1
--  *************************** taste aadl parser ***********************  --
Maxime Perrotin's avatar
Maxime Perrotin committed
2
--  (c) 2019 European Space Agency - maxime.perrotin@esa.int
3
4
--  LGPL license, see LICENSE file

Maxime Perrotin's avatar
Maxime Perrotin committed
5
6
with Ada.Directories,
     Ada.IO_Exceptions,
Maxime Perrotin's avatar
Maxime Perrotin committed
7
8
     Ada.Exceptions,
     Ada.Characters.Latin_1;
Maxime Perrotin's avatar
Maxime Perrotin committed
9
10
11

use Ada.Directories;

12
13
package body TASTE.Concurrency_View is

Maxime Perrotin's avatar
Maxime Perrotin committed
14
15
   Newline : Character renames Ada.Characters.Latin_1.LF;

16
   procedure Debug_Dump (CV : Taste_Concurrency_View; Output : File_Type) is
Maxime Perrotin's avatar
Maxime Perrotin committed
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
      procedure Dump_Partition (Partition : CV_Partition) is
      begin
         for Block of Partition.Blocks loop
            Put_Line (Output, "Protected Block : " & To_String (Block.Name));
            for Provided of Block.Provided loop
               Put_Line (Output, " |_ PI : " & To_String (Provided.Name));
            end loop;
            for Required of Block.Required loop
               Put_Line (Output, " |_ RI : " & To_String (Required.Name));
            end loop;
            for Thread of Block.Calling_Threads loop
               Put_Line (Output, " |_ Calling_Thread : " & Thread);
            end loop;
            if Block.Node.Has_Value then
               Put_Line (Output, " |_ Node : "
                         & To_String (Block.Node.Unsafe_Just.Name));
               declare
                  P : constant Taste_Partition :=
                    Block.Node.Unsafe_Just.Find_Partition
                      (To_String (Block.Name)).Unsafe_Just;
               begin
                  Put_Line (Output, " |_ Partition : " & To_String (P.Name));
                  Put_Line (Output, "   |_ Coverage       : "
                            & P.Coverage'Img);
                  Put_Line (Output, "   |_ Package        : "
                            & To_String (P.Package_Name));
                  Put_Line (Output, "   |_ CPU Name       : "
                            & To_String (P.CPU_Name));
                  Put_Line (Output, "   |_ CPU Platform   : "
                            & P.CPU_Platform'Img);
                  Put_Line (Output, "   |_ CPU Classifier : "
                            & To_String (P.CPU_Classifier));
               end;
            end if;
Maxime Perrotin's avatar
Maxime Perrotin committed
51
         end loop;
52

Maxime Perrotin's avatar
Maxime Perrotin committed
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
         for Thread of Partition.Threads loop
            Put_Line (Output, "Thread : " & To_String (Thread.Name));
            Put_Line (Output, " |_ Port : "
                      & To_String (Thread.Entry_Port_Name));
            Put_Line (Output, " |_ Protected Block : "
                      & To_String (Thread.Protected_Block_Name));
            Put_Line (Output, " |_ Node : "
                      & To_String (Thread.Node.Value_Or
                        (Taste_Node'(Name   => US ("(none)"),
                                     others => <>)).Name));
            for Out_Port of Thread.Output_Ports loop
               Put_Line (Output, " |_ Output port remote thread : "
                         & To_String (Out_Port.Remote_Thread));
               Put_Line (Output, " |_ Output port remote PI : "
                         & To_String (Out_Port.Remote_PI));
            end loop;
         end loop;
      end Dump_Partition;
   begin
      for Node of CV.Nodes loop
         for Partition of Node.Partitions loop
            Dump_Partition (Partition);
Maxime Perrotin's avatar
Maxime Perrotin committed
75
         end loop;
76
77
78
      end loop;
   end Debug_Dump;

79
   --  This function translates a protected block into a template
80
   function Prepare_Template (B : Protected_Block) return Block_As_Template is
81
      Calling_Threads : Tag;
82
      Result : Block_As_Template;
83
84
85
86
87
   begin
      for Thread of B.Calling_Threads loop
         Calling_Threads := Calling_Threads & Thread;
      end loop;

88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
      for PI of B.Provided loop
         declare
            Basic : constant Translate_Set := PI.PI.To_Template
              & Assoc ("Protected_Block_Name", To_String (PI.Name))
              & Assoc ("Caller_Is_Local", PI.Local_Caller);
         begin
            Result.Provided.Append (Basic);
         end;
      end loop;

      for RI of B.Required loop
         Result.Required.Append (RI.To_Template);
      end loop;

      Result.Header := +Assoc  ("Name",            To_String (B.Name))
                       & Assoc ("Calling_Threads", Calling_Threads)
                       & Assoc ("Node_Name",       To_String (B.Node.Value_Or
                         (Taste_Node'(Name => US (""), others => <>)).Name));
      return Result;
107
   end Prepare_Template;
108
109

   --  This function translates a thread definition into a template
Maxime Perrotin's avatar
Maxime Perrotin committed
110
   function To_Template (T : AADL_Thread) return Translate_Set is
111
112
113
114
115
116
117
118
119
120
121
122
123
124
      Remote_Thread : Vector_Tag;
      Remote_PI     : Vector_Tag;
   begin
      for Out_Port of T.Output_Ports loop
         Remote_Thread := Remote_Thread & To_String (Out_Port.Remote_Thread);
         Remote_PI     := Remote_PI     & To_String (Out_Port.Remote_PI);
      end loop;

      return Result : constant Translate_Set :=
        (+Assoc  ("Name",            To_String (T.Name))
         & Assoc ("Entry_Port_Name", To_String (T.Entry_Port_Name))
         & Assoc ("Pro_Block_Name",  To_String (T.Protected_Block_Name))
         & Assoc ("Node_Name",       To_String (T.Node.Value_Or
           (Taste_Node'(Name => US (""), others => <>)).Name))
Maxime Perrotin's avatar
Maxime Perrotin committed
125
126
         & Assoc ("Remote_Threads",  Remote_Thread)
         & Assoc ("Remote_PIs",      Remote_PI));
Maxime Perrotin's avatar
Maxime Perrotin committed
127
   end To_Template;
128

Maxime Perrotin's avatar
Maxime Perrotin committed
129
130
   --  Generate the output file for one node
   procedure Generate_Node (CV : Taste_Concurrency_View; Node_Name : String)
131
   is
Maxime Perrotin's avatar
Maxime Perrotin committed
132
      Prefix   : constant String := CV.Base_Template_Path.Element
Maxime Perrotin's avatar
Maxime Perrotin committed
133
134
135
136
137
138
139
        & "templates/concurrency_view";
      --  To iterate over template folders
      ST       : Search_Type;
      Current  : Directory_Entry_Type;
      Filter   : constant Filter_Type := (Directory => True,
                                          others    => False);
      Output_File : File_Type;
Maxime Perrotin's avatar
Maxime Perrotin committed
140
141
      Output_Dir  : constant String :=
        CV.Base_Output_Path.Element & "/concurrency_view/" & Node_Name;
Maxime Perrotin's avatar
Maxime Perrotin committed
142
   begin
Maxime Perrotin's avatar
Maxime Perrotin committed
143
144
      Put_Info ("Generating Concurrency View for node " & Node_Name);
      --  All files for one node are created in the same folder - create it
Maxime Perrotin's avatar
Maxime Perrotin committed
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
      Create_Path (Output_Dir);

      Start_Search (Search    => ST,
                    Pattern   => "",
                    Directory => Prefix,
                    Filter    => Filter);

      if not More_Entries (ST) then
         --  On Unix, this will never happen because "." and ".." are part
         --  of the search result. We'll only get an IO Error if the
         --  concurrency_view folder itself does not exist
         raise Concurrency_View_Error with
           "No folders with templates for concurrency view";
      end if;

      --  Iterate over the folders and process templates
      while More_Entries (ST) loop
         Get_Next_Entry (ST, Current);

         --  Ignore Unix special directories
         if Simple_Name (Current) = "." or Simple_Name (Current) = ".." then
            goto continue;
         end if;

Maxime Perrotin's avatar
Maxime Perrotin committed
169
         declare
Maxime Perrotin's avatar
Maxime Perrotin committed
170
            Path  : constant String  := Full_Name (Current);
Maxime Perrotin's avatar
Maxime Perrotin committed
171
            Do_It : constant Boolean := Exists (Path & "/filename.tmplt");
Maxime Perrotin's avatar
Maxime Perrotin committed
172
173
            Filename_Set : constant Translate_Set :=
              +Assoc ("Node_Name", Node_Name);
Maxime Perrotin's avatar
Maxime Perrotin committed
174
175
176
            --  Get output file name from template
            File_Name : constant String :=
              (if Do_It then
Maxime Perrotin's avatar
Maxime Perrotin committed
177
                  Strip_String (Parse (Path & "/filename.tmplt", Filename_Set))
Maxime Perrotin's avatar
Maxime Perrotin committed
178
179
180
181
182
183
184
185
186
187
               else "");
            --  Check if file already exists
            Present : constant Boolean :=
              (File_Name /= "" and Exists (Output_Dir & File_Name));
            Trig_Tmpl : constant Translate_Set :=
              +Assoc ("Filename_Is_Present", Present);
            Trigger : constant Boolean :=
              (Exists (Path & "/trigger.tmplt") and then
               Strip_String
                 (Parse (Path & "/trigger.tmplt", Trig_Tmpl)) = "TRUE");
Maxime Perrotin's avatar
Maxime Perrotin committed
188

Maxime Perrotin's avatar
Maxime Perrotin committed
189
            function Generate_Partition (Partition_Name : String)
Maxime Perrotin's avatar
Maxime Perrotin committed
190
                                         return String
Maxime Perrotin's avatar
Maxime Perrotin committed
191
            is
Maxime Perrotin's avatar
Maxime Perrotin committed
192
193
               Partition       : constant CV_Partition :=
                 CV.Nodes (Node_Name).Partitions (Partition_Name);
Maxime Perrotin's avatar
Maxime Perrotin committed
194
195
               Threads         : Unbounded_String;
               Blocks          : Unbounded_String;
Maxime Perrotin's avatar
Maxime Perrotin committed
196
               Partition_Assoc : Translate_Set;
Maxime Perrotin's avatar
Maxime Perrotin committed
197
            begin
198
199
200
201
202
203
204
               for T of Partition.Threads loop
                  declare
                     --  Render each thread
                     Thread_Assoc : constant Translate_Set := T.To_Template;
                     Result : constant String :=
                       (Parse (Path & "/thread.tmplt", Thread_Assoc));
                  begin
Maxime Perrotin's avatar
Maxime Perrotin committed
205
                     Threads := Threads & Newline & Result;
206
                  end;
Maxime Perrotin's avatar
Maxime Perrotin committed
207
               end loop;
208
209
210
211
               for B of Partition.Blocks loop
                  declare
                     Tmpl : constant Block_As_Template := B.Prepare_Template;
                     Block_Assoc : Translate_Set := Tmpl.Header;
Maxime Perrotin's avatar
Maxime Perrotin committed
212
213
                     PI_Tag : Unbounded_String;
                     RI_Tag : Unbounded_String;
214
215
                  begin
                     for PI_Assoc of Tmpl.Provided loop
Maxime Perrotin's avatar
Maxime Perrotin committed
216
                        PI_Tag := PI_Tag & Newline
217
218
219
                          & String'(Parse (Path & "/pi.tmplt", PI_Assoc));
                     end loop;
                     for RI_Assoc of Tmpl.Required loop
Maxime Perrotin's avatar
Maxime Perrotin committed
220
                        RI_Tag := RI_Tag & Newline
221
222
223
224
225
226
                          & String'(Parse (Path & "/ri.tmplt", RI_Assoc));
                     end loop;
                     Block_Assoc := Block_Assoc
                       & Assoc ("Provided", PI_Tag)
                       & Assoc ("Required", RI_Tag);

Maxime Perrotin's avatar
Maxime Perrotin committed
227
                     Blocks := Blocks & Newline &
228
229
                       String'(Parse (Path & "/block.tmplt", Block_Assoc));
                  end;
Maxime Perrotin's avatar
Maxime Perrotin committed
230
               end loop;
231
232
233
234
               --  Association includes Name, Coverage, CPU Info, etc.
               --  (see taste-deployment_view.ads for the complete list)
               Partition_Assoc := Partition.Deployment_Partition.To_Template
                 & Assoc ("Threads", Threads)
Maxime Perrotin's avatar
Maxime Perrotin committed
235
                 & Assoc ("Blocks",  Blocks);
236

Maxime Perrotin's avatar
Maxime Perrotin committed
237
               return Parse (Path & "/partition.tmplt", Partition_Assoc);
Maxime Perrotin's avatar
Maxime Perrotin committed
238
            end Generate_Partition;
Maxime Perrotin's avatar
Maxime Perrotin committed
239

Maxime Perrotin's avatar
Maxime Perrotin committed
240
            Partitions : Unbounded_String;
Maxime Perrotin's avatar
Maxime Perrotin committed
241
242
            Node_Assoc : Translate_Set;

Maxime Perrotin's avatar
Maxime Perrotin committed
243
244
         begin
            if Trigger then
Maxime Perrotin's avatar
Maxime Perrotin committed
245
246
247
               for Partition in CV.Nodes (Node_Name).Partitions.Iterate loop
                  Partitions := Partitions
                    & Generate_Partition (CV_Partitions.Key (Partition));
Maxime Perrotin's avatar
Maxime Perrotin committed
248
               end loop;
Maxime Perrotin's avatar
Maxime Perrotin committed
249
250
               Node_Assoc := +Assoc ("Partitions", Partitions)
                  & Assoc ("Node_Name", Node_Name);
Maxime Perrotin's avatar
Maxime Perrotin committed
251
252
253
254

               Put_Info ("Generating from " & Path);
               Create (File => Output_File,
                       Mode => Out_File,
Maxime Perrotin's avatar
Maxime Perrotin committed
255
                       Name => Output_Dir & "/" & File_Name);
Maxime Perrotin's avatar
Maxime Perrotin committed
256
257
258
               Put_Line (Output_File,
                         Parse (Path & "/node.tmplt", Node_Assoc));
               Close (Output_File);
Maxime Perrotin's avatar
Maxime Perrotin committed
259
260
            end if;
         end;
Maxime Perrotin's avatar
Maxime Perrotin committed
261
262
         <<continue>>
      end loop;
Maxime Perrotin's avatar
Maxime Perrotin committed
263
      End_Search (ST);
Maxime Perrotin's avatar
Maxime Perrotin committed
264
   end Generate_Node;
265
266
267
268
   procedure Generate_System (CV : Taste_Concurrency_View) is
   begin
      null;
   end Generate_System;
Maxime Perrotin's avatar
Maxime Perrotin committed
269
270
271

   procedure Generate_CV (CV : Taste_Concurrency_View) is
   begin
272
273
274
275
      --  In this first iteration Nodes are generated in standalone files,
      --  and they include their processes. It would be useful to be able
      --  to decide if processes could also have their own files, since
      --  in the future they may be more than one process per node (for TSP).
Maxime Perrotin's avatar
Maxime Perrotin committed
276
      for Node in CV.Nodes.Iterate loop
277
278
279
         if CV_Nodes.Key (Node) /= "interfaceview" then
            CV.Generate_Node (CV_Nodes.Key (Node));
         end if;
Maxime Perrotin's avatar
Maxime Perrotin committed
280
      end loop;
281
      CV.Generate_System;
Maxime Perrotin's avatar
Maxime Perrotin committed
282
283
284
285
286
287
   exception
      when Error : Concurrency_View_Error | Ada.IO_Exceptions.Name_Error =>
         Put_Error ("Concurrency View : "
                    & Ada.Exceptions.Exception_Message (Error));
         raise Quit_Taste;
   end Generate_CV;
Maxime Perrotin's avatar
Maxime Perrotin committed
288

289
end TASTE.Concurrency_View;