taste-concurrency_view.adb 9.83 KB
Newer Older
1
2
3
4
5
6
--  *************************** taste aadl parser ***********************  --
--  (c) 2018 European Space Agency - maxime.perrotin@esa.int
--  LGPL license, see LICENSE file

--  Concurrency View

Maxime Perrotin's avatar
Maxime Perrotin committed
7
8
9
10
11
12
with Ada.Directories,
     Ada.IO_Exceptions,
     Ada.Exceptions;

use Ada.Directories;

13
14
15
package body TASTE.Concurrency_View is

   procedure Debug_Dump (CV : Taste_Concurrency_View; Output : File_Type) is
Maxime Perrotin's avatar
Maxime Perrotin committed
16
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
      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
50
         end loop;
51

Maxime Perrotin's avatar
Maxime Perrotin committed
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
         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
74
         end loop;
75
76
77
      end loop;
   end Debug_Dump;

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

87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
      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;
Maxime Perrotin's avatar
Maxime Perrotin committed
106
   end To_Template;
107
108

   --  This function translates a thread definition into a template
Maxime Perrotin's avatar
Maxime Perrotin committed
109
   function To_Template (T : AADL_Thread) return Translate_Set is
110
111
112
113
114
115
116
117
118
119
120
121
122
123
      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
124
125
         & Assoc ("Remote_Threads",  Remote_Thread)
         & Assoc ("Remote_PIs",      Remote_PI));
Maxime Perrotin's avatar
Maxime Perrotin committed
126
   end To_Template;
127

Maxime Perrotin's avatar
Maxime Perrotin committed
128
129
   --  Generate the output file for one node
   procedure Generate_Node (CV : Taste_Concurrency_View; Node_Name : String)
130
   is
Maxime Perrotin's avatar
Maxime Perrotin committed
131
      Prefix   : constant String := CV.Base_Template_Path.Element
Maxime Perrotin's avatar
Maxime Perrotin committed
132
133
134
135
136
137
138
        & "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
139
140
      Output_Dir  : constant String :=
        CV.Base_Output_Path.Element & "/concurrency_view/" & Node_Name;
Maxime Perrotin's avatar
Maxime Perrotin committed
141
   begin
Maxime Perrotin's avatar
Maxime Perrotin committed
142
143
      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
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
      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
168
         declare
Maxime Perrotin's avatar
Maxime Perrotin committed
169
            Path  : constant String  := Full_Name (Current);
Maxime Perrotin's avatar
Maxime Perrotin committed
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
            Do_It : constant Boolean := Exists (Path & "/filename.tmplt");
            --  Get output file name from template
            File_Name : constant String :=
              (if Do_It then
                  Strip_String (Parse (Path & "/filename.tmplt"))
               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
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204

            function Generate_Partition (Partition : CV_Partition)
                                         return Translate_Set
            is
               Threads : Tag;
               Blocks  : Tag;
            begin
               for Thread of Partition.Threads loop
                  --  Render each thread
                  Threads := Threads & "This_Thread";
                  --  & String'(Parse (Path & "/thread.tmplt", Thread_Assoc));
               end loop;
               for Block of Partition.Blocks loop
                  --  Render each block
                  Blocks := Blocks & "This block";
                  --  String'(Parse (Path & "/block.tmplt", Block_Assoc));
               end loop;
               return Translate_Set'(+Assoc  ("Threads", Threads)
                                     & Assoc ("Blocks",  Blocks));
            end Generate_Partition;
Maxime Perrotin's avatar
Maxime Perrotin committed
205
         begin
Maxime Perrotin's avatar
Maxime Perrotin committed
206
207
208
            --  A node contains partitions, we must render them all separately
            --  using their own templates (threads and blocks), and then call
            --  use the node template with these tags.
Maxime Perrotin's avatar
Maxime Perrotin committed
209
            if Trigger then
Maxime Perrotin's avatar
Maxime Perrotin committed
210
211
212
213
214
215
216
217
218
219
220
221
222
223
               for Partition of CV.Nodes (Node_Name).Partitions loop
                  declare
                     Partition_Assoc : constant Translate_Set :=
                       Generate_Partition (Partition);
                  begin
                     Put_Info ("Generating from " & Path);
                     Create (File => Output_File,
                             Mode => Out_File,
                             Name => Output_Dir & File_Name);
                     Put_Line (Output_File,
                               Parse (Path & "/node.tmplt", Partition_Assoc));
                     Close (Output_File);
                  end;
               end loop;
Maxime Perrotin's avatar
Maxime Perrotin committed
224
225
            end if;
         end;
Maxime Perrotin's avatar
Maxime Perrotin committed
226
227
         <<continue>>
      end loop;
Maxime Perrotin's avatar
Maxime Perrotin committed
228
      End_Search (ST);
Maxime Perrotin's avatar
Maxime Perrotin committed
229
230
231
232
233
234
235
   end Generate_Node;

   procedure Generate_CV (CV : Taste_Concurrency_View) is
   begin
      for Node in CV.Nodes.Iterate loop
         CV.Generate_Node (CV_Nodes.Key (Node));
      end loop;
Maxime Perrotin's avatar
Maxime Perrotin committed
236
237
238
239
240
241
   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
242

243
end TASTE.Concurrency_View;