1
------------------------------------------------------------------------------
2
--                                                                          --
3
--                           OCARINA COMPONENTS                             --
4
--                                                                          --
5
--                OCARINA.FE_AADL_BA.PARSER.THREAD_DISPATCH                 --
6
--                                                                          --
7
--                                 B o d y                                  --
8
--                                                                          --
9
--                  Copyright (C) 2009 Telecom ParisTech,                   --
10
--                 2010-2019 ESA & ISAE, 2019-2020 OpenAADL                 --
11
--                                                                          --
12
-- Ocarina  is free software; you can redistribute it and/or modify under   --
13
-- terms of the  GNU General Public License as published  by the Free Soft- --
14
-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
15
-- sion. Ocarina is distributed in the hope that it will be useful, but     --
16
-- WITHOUT ANY WARRANTY; without even the implied warranty of               --
17
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                     --
18
--                                                                          --
19
-- As a special exception under Section 7 of GPL version 3, you are granted --
20
-- additional permissions described in the GCC Runtime Library Exception,   --
21
-- version 3.1, as published by the Free Software Foundation.               --
22
--                                                                          --
23
-- You should have received a copy of the GNU General Public License and    --
24
-- a copy of the GCC Runtime Library Exception along with this program;     --
25
-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
26
-- <http://www.gnu.org/licenses/>.                                          --
27
--                                                                          --
28
--                    Ocarina is maintained by OpenAADL team                --
29
--                              (info@openaadl.org)                         --
30
--                                                                          --
31
------------------------------------------------------------------------------
32

33
with Ocarina.FE_AADL_BA.Lexer;
34
with Ocarina.FE_AADL_BA.Parser.Identifiers;
35
with Ocarina.FE_AADL_BA.Parser.Expressions;
36

37
with Ocarina.ME_AADL_BA;
38
with Ocarina.ME_AADL_BA.Tokens;
39
with Ocarina.ME_AADL_BA.BA_Tree.Nutils;
40

41
with Ocarina.Builder.Aadl_Ba.Thread_Dispatch;
42

43
package body Ocarina.FE_AADL_BA.Parser.Thread_Dispatch is
44

45
   use Locations;
46
   use Ocarina.FE_AADL_BA.Lexer;
47
   use Ocarina.FE_AADL_BA.Parser.Identifiers;
48
   use Ocarina.FE_AADL_BA.Parser.Expressions;
49

50
   use Ocarina.ME_AADL_BA;
51
   use Ocarina.ME_AADL_BA.Tokens;
52
   use Ocarina.ME_AADL_BA.BA_Tree.Nutils;
53

54
   use Ocarina.Builder.Aadl_Ba.Thread_Dispatch;
55

56
   function P_Dispatch_Trigger_Condition
57
     (Container : Types.Node_Id)
58
    return Node_Id;
59

60
   function P_Dispatch_Conjunction
61
     (Container : Types.Node_Id)
62
    return Node_Id;
63

64
   --------------------------
65
   -- P_Dispatch_Condition --
66
   --------------------------
67

68
   --  dispatch_condition ::=
69
   --    on dispatch [ dispatch_trigger_condition ] [ frozen frozen_ports ]
70

71
   --  frozen_ports ::=
72
   --    in_port_name { , in_port_name }*
73

74 1
   function P_Dispatch_Condition (Container : Types.Node_Id)
75
     return Node_Id
76
   is
77 1
      Start_Loc                  : Location;
78 1
      Loc                        : Location;
79

80 1
      Frozen_Port_List           : List_Id   := No_List;
81 1
      Dispatch_Trigger_Condition : Node_Id;
82 1
      Dispatch_Condition         : Node_Id;
83
   begin
84 1
      Save_Lexer (Start_Loc);
85 1
      Scan_Token;  -- consume T_On
86

87 1
      Dispatch_Condition := Add_New_Dispatch_Condition_Thread (Start_Loc,
88
                                                               Container,
89
                                                               No_Node,
90
                                                               No_List);
91

92 1
      if No (Dispatch_Condition) then
93 0
         DPE (PC_Dispatch_Condition, EMC_Failed);
94 0
         Skip_Tokens (T_Semicolon);
95 0
         return No_Node;
96
      end if;
97

98 1
      Scan_Token;
99 1
      if Token /= T_Dispatch then
100 0
         Restore_Lexer (Start_Loc);
101 0
         DPE (PC_Dispatch_Condition,
102
              Expected_Token => T_Dispatch);
103 0
         Skip_Tokens (T_Semicolon);
104 0
         return No_Node;
105
      end if;
106

107 1
      Dispatch_Trigger_Condition := P_Dispatch_Trigger_Condition
108
                                       (Dispatch_Condition);
109

110 1
      if No (Dispatch_Trigger_Condition) then
111 0
         DPE (PC_Dispatch_Condition, EMC_Failed);
112 0
         Skip_Tokens (T_Semicolon);
113 0
         return No_Node;
114
      end if;
115

116 1
      Save_Lexer (Loc);
117 1
      Scan_Token;
118 1
      if Token = T_Frozen then
119 1
         Frozen_Port_List := P_Items_List (P_Identifier'Access,
120
                                           Dispatch_Condition,
121
                                           T_Comma);
122

123 1
         if Is_Empty (Frozen_Port_List) then
124 0
            Scan_Token;
125 0
            DPE (PC_Dispatch_Condition, Expected_Token => T_Identifier);
126 0
            Skip_Tokens (T_Semicolon);
127 0
            return No_Node;
128
         end if;
129
      else
130 1
         Restore_Lexer (Loc);
131
      end if;
132

133 1
      Add_New_Dispatch_Condition_Thread (Dispatch_Condition,
134
                                         Container,
135
                                         Dispatch_Trigger_Condition,
136
                                         Frozen_Port_List);
137

138 1
      return Dispatch_Condition;
139 1
   end P_Dispatch_Condition;
140

141
   ----------------------------------
142
   -- P_Dispatch_Trigger_Condition --
143
   ----------------------------------
144

145
   --  dispatch_trigger_condition ::=
146
   --    dispatch_trigger_logical_expression
147
   --  | provides_subprogram_access_name
148
   --  | stop
149
   --  | completion_relative_timeout_condition_and_catch
150
   --  | dispatch_relative_timeout_catch
151

152
   --  dispatch_trigger_logical_expression ::=
153
   --    dispatch_conjunction { or dispatch_conjunction }*
154

155
   --  completion_relative_timeout_condition_and_catch ::=
156
   --    timeout [ (event_port_name*) ] behavior_time
157

158
   --  dispatch_relative_timeout_catch ::=
159
   --    timeout
160

161 1
   function P_Dispatch_Trigger_Condition (Container : Types.Node_Id)
162
    return Node_Id
163
   is
164 1
      Start_Loc                  : Location;
165 1
      Loc                        : Location;
166 1
      Dispatch_Trigger_Condition : Node_Id;
167 1
      Behavior_Time              : Node_Id                := No_Node;
168 1
      Dispatch_Conjunction_List   : List_Id                := No_List;
169 1
      Trig_Kind                  : Dispatch_Trigger_Kind;
170
   begin
171 1
      Save_Lexer (Start_Loc);
172

173 1
      Scan_Token;
174
      case Token is
175 1
         when T_Timeout =>
176 1
            Trig_Kind := TRI_Timeout;
177

178 1
            Save_Lexer (Loc);
179 1
            Scan_Token;
180 1
            if Token = T_Real_Literal
181 1
              or else Token = T_Integer_Literal
182
            then
183 0
               Restore_Lexer (Loc);
184 0
               Behavior_Time := P_Behavior_Time (No_Node);
185

186 0
               if No (Behavior_Time) then
187 0
                  DPE (PC_Dispatch_Trigger_Condition, EMC_Failed);
188 0
                  Skip_Tokens (T_Semicolon);
189 0
                  return No_Node;
190
               end if;
191
            else
192 1
               Restore_Lexer (Loc);
193
            end if;
194

195 0
         when T_Stop =>
196 0
            Trig_Kind := TRI_Stop;
197

198 1
         when T_Identifier =>
199 1
            Trig_Kind := TRI_No_Kind;
200 1
            Restore_Lexer (Start_Loc);
201 1
            Dispatch_Conjunction_List := P_Items_List
202
                                        (P_Dispatch_Conjunction'Access,
203
                                         No_Node,
204
                                         T_Or);
205 1
            if Is_Empty (Dispatch_Conjunction_List) then
206 0
               DPE (PC_Dispatch_Trigger_Condition,
207
                    EMC_List_Is_Empty);
208 0
               Skip_Tokens (T_Semicolon);
209 0
               return No_Node;
210
            end if;
211

212 1
         when others =>
213 1
            Trig_Kind := TRI_No_Kind;
214 1
            Restore_Lexer (Start_Loc);
215
      end case;
216

217 1
      Dispatch_Trigger_Condition := Add_New_Dispatch_Trigger_Condition
218
                                    (Start_Loc,
219
                                     Container,
220
                                     Trig_Kind,
221
                                     Dispatch_Conjunction_List,
222
                                     Behavior_Time);
223

224 1
      if No (Dispatch_Trigger_Condition) then
225 0
         DPE (PC_Dispatch_Trigger_Condition, EMC_Failed);
226 0
         Skip_Tokens (T_Semicolon);
227 0
         return No_Node;
228
      else
229 1
         return Dispatch_Trigger_Condition;
230
      end if;
231

232 1
   end P_Dispatch_Trigger_Condition;
233

234
   ------------------------------------
235
   -- P_Dispatch_Conjunction --
236
   ------------------------------------
237

238
   --  dispatch_conjunction ::=
239
   --    dispatch_trigger { and dispatch_trigger }*
240

241
   --  dispatch_trigger ::=
242
   --    in_event_port_identifier
243
   --  | in_event_data_port_identifier
244

245 1
   function P_Dispatch_Conjunction
246
     (Container : Types.Node_Id)
247
     return Node_Id
248
   is
249 1
      Loc                         : Location;
250 1
      Dispatch_Conjunction_Node   : Node_Id := No_Node;
251 1
      Dispatch_Triggers           : List_Id  := No_List;
252
   begin
253 1
      Save_Lexer (Loc);
254 1
      Scan_Token;
255

256 1
      if Token = T_Identifier then
257 1
         Restore_Lexer (Loc);
258 1
         Dispatch_Triggers := P_Items_List (P_Identifier'Access,
259
                                           No_Node,
260
                                           T_And);
261

262 1
         if Is_Empty (Dispatch_Triggers) then
263 0
            Scan_Token;
264 0
            DPE (PC_Dispatch_Trigger, Expected_Token => T_Identifier);
265 0
            Skip_Tokens (T_Semicolon);
266 0
            return No_Node;
267
         end if;
268
      else
269 0
         DPE (PC_Dispatch_Conjunction,
270
              Expected_Token => T_Identifier);
271 0
         Skip_Tokens (T_Semicolon);
272 0
         return No_Node;
273
      end if;
274

275 1
      if not Is_Empty (Dispatch_Triggers) then
276 1
         Dispatch_Conjunction_Node := Add_New_Dispatch_Conjunction (Loc,
277
                                                           Container,
278
                                                           Dispatch_Triggers);
279
      end if;
280 1
      if No (Dispatch_Conjunction_Node) then
281 0
         DPE (PC_Dispatch_Conjunction, EMC_Failed);
282 0
         Skip_Tokens (T_Semicolon);
283 0
         return No_Node;
284
      else
285 1
         return Dispatch_Conjunction_Node;
286
      end if;
287

288 1
   end P_Dispatch_Conjunction;
289

290
end Ocarina.FE_AADL_BA.Parser.Thread_Dispatch;

Read our documentation on viewing source code .

Loading