taste-concurrency_view.adb 9.19 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
16
package body TASTE.Concurrency_View is

   procedure Debug_Dump (CV : Taste_Concurrency_View; Output : File_Type) is
   begin
Maxime Perrotin's avatar
Maxime Perrotin committed
17
18
19
20
21
22
23
24
25
26
27
      for Block of CV.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;
Maxime Perrotin's avatar
Maxime Perrotin committed
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
         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;
48
49
      end loop;

Maxime Perrotin's avatar
Maxime Perrotin committed
50
51
52
53
54
55
56
57
58
59
60
61
62
63
      for Thread of CV.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;
64
65
66
      end loop;
   end Debug_Dump;

67
   --  This function translates a protected block into a template
68
   function To_Template (B : Protected_Block) return Block_As_Template is
69
      Calling_Threads : Tag;
70
      Result : Block_As_Template;
71
72
73
74
75
   begin
      for Thread of B.Calling_Threads loop
         Calling_Threads := Calling_Threads & Thread;
      end loop;

76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
      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
95
   end To_Template;
96
97

   --  This function translates a thread definition into a template
Maxime Perrotin's avatar
Maxime Perrotin committed
98
   function To_Template (T : AADL_Thread) return Translate_Set is
99
100
101
102
103
104
105
106
107
108
109
110
111
112
      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
113
114
         & Assoc ("Remote_Threads",  Remote_Thread)
         & Assoc ("Remote_PIs",      Remote_PI));
Maxime Perrotin's avatar
Maxime Perrotin committed
115
   end To_Template;
116

117
   function Concurrency_View_Template (CV : Taste_Concurrency_View)
118
119
                                       return CV_As_Template
   is
120
121
      Result : CV_As_Template;
   begin
122
      for Thread of CV.Threads loop
Maxime Perrotin's avatar
Maxime Perrotin committed
123
         Result.Threads.Append (Thread.To_Template);
124
125
      end loop;
      for Pro of CV.Blocks loop
Maxime Perrotin's avatar
Maxime Perrotin committed
126
         Result.Blocks.Append (Pro.To_Template);
127
      end loop;
128
129
      return Result;
   end Concurrency_View_Template;
Maxime Perrotin's avatar
Maxime Perrotin committed
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144

   --  Parse the template files to generate the CV output with Templates_parser
   procedure Generate_CV (CV                 : Taste_Concurrency_View;
                          Base_Template_Path : String;
                          Base_Output_Path   : String)
   is
      Prefix   : constant String := Base_Template_Path
        & "templates/concurrency_view";
      Template : constant CV_As_Template := CV.Concurrency_View_Template;
      --  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
145
      Output_Dir  : constant String := Base_Output_Path & "/concurrency_view/";
Maxime Perrotin's avatar
Maxime Perrotin committed
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
   begin
      Put_Info ("Generating Concurrency View");
      --  All files are created in the same folder - create it
      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
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
         declare
            Path : constant String := Full_Name (Current);
            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");
         begin
Maxime Perrotin's avatar
Maxime Perrotin committed
191
192
193
194
            --  We have threads and blocks
            --  Threads: it is a vector of translate set meaning that we can
            --  render them directly from a template and keep them in a vector
            --  of strings.
Maxime Perrotin's avatar
Maxime Perrotin committed
195
            if Trigger then
Maxime Perrotin's avatar
Maxime Perrotin committed
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
               declare
                  Threads : Tag;
                  Blocks  : Tag;
                  Result  : Translate_Set;
               begin
                  Put_Info ("Generating from " & Path);
                  for Thread of Template.Threads loop
                     --  Render each thread
                     Threads := Threads
                       & String'(Parse (Path & "/thread.tmplt", Thread));
                  end loop;
                  for Block of Template.Blocks loop
                     --  Render each block
                     null;
                  end loop;
                  Result := +Assoc  ("Threads", Threads)
                            & Assoc ("Blocks",  Blocks);

                  Create (File => Output_File,
                          Mode => Out_File,
                          Name => Output_Dir & File_Name);
                  Put_Line (Output_File, Parse (Path & "/cv.tmplt", Result));
                  Close (Output_File);
               end;
Maxime Perrotin's avatar
Maxime Perrotin committed
220
221
            end if;
         end;
Maxime Perrotin's avatar
Maxime Perrotin committed
222
223
         <<continue>>
      end loop;
Maxime Perrotin's avatar
Maxime Perrotin committed
224
      End_Search (ST);
Maxime Perrotin's avatar
Maxime Perrotin committed
225
226
227
228
229
230
   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;
231
end TASTE.Concurrency_View;