ocarina-backends-utils.ads 20.7 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 . U T I L S                --
--                                                                          --
--                                 S p e c                                  --
--                                                                          --
9
--    Copyright (C) 2005-2009 Telecom ParisTech, 2010-2014 ESA & ISAE.      --
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
--                                                                          --
-- Ocarina  is free software;  you  can  redistribute  it and/or  modify    --
-- it under terms of the GNU General Public License as published by the     --
-- Free Software Foundation; either version 2, or (at your option) any      --
-- later version. 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. See the GNU General --
-- Public License for more details. You should have received  a copy of the --
-- GNU General Public License distributed with Ocarina; see file COPYING.   --
-- If not, write to the Free Software Foundation, 51 Franklin Street, Fifth --
-- Floor, Boston, MA 02111-1301, USA.                                       --
--                                                                          --
-- As a special exception,  if other files  instantiate  generics from this --
-- unit, or you link  this unit with other files  to produce an executable, --
-- this  unit  does not  by itself cause  the resulting  executable to be   --
-- covered  by the  GNU  General  Public  License. This exception does not  --
-- however invalidate  any other reasons why the executable file might be   --
-- covered by the GNU Public License.                                       --
--                                                                          --
jhugues's avatar
jhugues committed
29
30
--                 Ocarina is maintained by the TASTE project               --
--                      (taste-users@lists.tuxfamily.org)                   --
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
--                                                                          --
------------------------------------------------------------------------------

with Ocarina.Backends.Properties; use Ocarina.Backends.Properties;

package Ocarina.Backends.Utils is

   type Browsing_Kind is (By_Source, By_Destination, Default);

   --------------------------
   -- Directory Operations --
   --------------------------

   procedure Create_Directory (Dir_Full_Name : Name_Id);
   --  Trys to create a directory and handle some creation errors

   procedure Enter_Directory (Dirname : Name_Id);
   --  Change the current directory to Dirname, and saves the
   --  old current_directory value.

   procedure Leave_Directory;
   --  Leave the latest entered directory and change to the latest
   --  left directory.

   function Add_Directory_Separator (Path : Name_Id) return Name_Id;
   --  If there is no directory separator at the end of the path,
   --  then add it and return the result. Else, return the same
   --  string.

   function Remove_Directory_Separator (Path : Name_Id) return Name_Id;
   --  If there is a directory separator at the end of the path, then
   --  remove it and return the result. Else, return the same string.

   ----------
   -- Misc --
   ----------

68
69
70
   function Normalize_Name
     (Name      : Name_Id;
      Ada_Style : Boolean := False) return Name_Id;
71
72
73
74
   --  Rewrite Name so that it only contains characters that are legal
   --  in most languages: a-z, 0-9, _.
   --  If Ada_Style is set to True, '.' is replaced by "__"

75
76
77
78
79
80
   function Fully_Qualified_Instance_Name (E : Node_Id) return Name_Id;
   --  Return a fully qualified name for component instance E, the
   --  fully qualified name is built from
   --  <system_name>_<process_name>_<thread_name> to avoid name
   --  collision

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
112
113
114
115
116
117
118
119
120
   -----------------------------------------------------
   -- Routines that are common to the code generators --
   -----------------------------------------------------

   function Is_Namespace (N : Node_Id) return Boolean;
   --  Return True if the node N corresponds to a namespace instance
   --  node.

   function Is_Delayed (E : Node_Id) return Boolean;
   --  Return True if the in data port instance E is involved in a
   --  delayed AADL connection.

   function Has_In_Parameters (E : Node_Id) return Boolean;
   --  Return True IFF the subprogram instance E contains at least one
   --  IN or IN OUT parameter.

   function Has_Out_Parameters (E : Node_Id) return Boolean;
   --  Return True IFF the subprogram instance E contains at least one
   --  OUT or IN OUT parameter.

   function Has_In_Ports (E : Node_Id) return Boolean;
   --  Return True IFF the component instance E contains at least one
   --  IN or IN OUT port.

   function Has_In_Event_Ports (E : Node_Id) return Boolean;
   --  Return True IFF the component instance E contains at least one
   --  IN or IN OUT event [data] port.

   function Has_Out_Ports (E : Node_Id) return Boolean;
   --  Return True IFF the component instance E contains at least one
   --  OUT or IN OUT port.

   function Has_Out_Event_Ports (E : Node_Id) return Boolean;
   --  Return True IFF the component instance E contains at least one
   --  OUT or IN OUT event [data] port.

   function Has_Ports (E : Node_Id) return Boolean;
   --  Return True IFF the component instance E contains at least one
   --  port.

121
122
123
124
125
126
127
128
   function Has_Output_Ports (E : Node_Id) return Boolean;
   --  Return True IFF the component instance E contains at least one
   --  output port.

   function Has_Input_Ports (E : Node_Id) return Boolean;
   --  Return True IFF the component instance E contains at least one
   --  input port.

129
130
131
132
133
134
135
136
137
138
139
140
   function Has_Modes (E : Node_Id) return Boolean;
   --  Return True IFF the entity instance E has AADL operational
   --  modes.

   function Get_Source_Ports (P : Node_Id) return List_Id;
   --  Return a node container list of all the THREAD OUT ports that
   --  are endpoint sources of the IN port P. If the connection path
   --  between P and one of its sources involves a connection
   --  bound to a bus instance, the bus instance will be the
   --  Extra_Item of the node container corresponding to the
   --  destination.

141
   function Get_Destination_Ports
142
143
     (P             : Node_Id;
      Custom_Parent : Node_Id := No_Node) return List_Id;
144
145
146
147
148
149
   --  Return a node container list of all the THREAD IN ports that
   --  are endpoint sources of the OUT port P. If the connection path
   --  between P and one of its destinations involves a connection
   --  bound to a bus instance, the bus instance will be the
   --  Extra_Item of the node container corresponding to the
   --  destination.
150
151
   --  Note: the list may be empty in the case of an event out port
   --  connected to a port that triggers a mode change.
152
153
154
155
156
157
158
159
160

   function Get_Actual_Owner (Spg_Call : Node_Id) return Node_Id;
   --  Return the data *subcomponent* whose corresponding component
   --  has the corresponding subprogram of Spg_Call as a
   --  feature. No_Node is returned id Spg_Call is not a method call
   --  or if its not connected to the data access provider.

   function Get_Container_Process (E : Node_Id) return Node_Id;
   --  Return the process subcomponent instance that contains the
161
162
   --  subprogram call or thread instance E, return No_Node if it
   --  cannot be determined.
163
164
165
166
167
168

   function Get_Container_Thread (E : Node_Id) return Node_Id;
   --  Return the thread subcomponent instance that contains the
   --  subprogram call E.

   function Get_Device_Of_Process
169
170
     (Bus     : Node_Id;
      Process : Node_Id) return Node_Id;
171
172
   --  Return the device the allows access to Process through Bus

173
   function Is_Connected (Bus : Node_Id; Device : Node_Id) return Boolean;
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
   --  Return true iff Device is used to interact with Bus

   type Comparison_Kind is (By_Name, By_Node);
   --  When we want to "handle" a node only once, the "once" criterion
   --  may be the name of the node (in which case two different nodes
   --  having the same name will be seen as the same node) or by node
   --  in which case two different nodes are seen as two different
   --  nodes.

   type Handling_Kind is
     (H_Ada_Activity_Interr_Body,
      H_Ada_Activity_Interr_Spec,
      H_Ada_Deployment_Spec,
      H_Ada_Helpers_Body,
      H_Ada_Helpers_Spec,
      H_Ada_Marshallers_Body,
      H_Ada_Marshallers_Spec,
      H_Ada_Namespaces_Body,
      H_Ada_Namespaces_Spec,
      H_Ada_Subprogram_Body,
      H_Ada_Subprogram_Spec,
      H_Ada_Type_Body,
      H_Ada_Type_Default_Value,
      H_Ada_Type_Spec,
      H_Add_Case_Alternative_Internals_Spec,
      H_Add_Case_Alternative_SSRA_Body,
      H_C_Marshall_Body,
      H_C_Marshall_Spec,
      H_C_Stub_Body,
      H_C_Stub_Spec,
      H_C_Deployment_Spec,
      H_C_Subprogram_Body,
      H_C_Subprogram_Spec,
      H_C_Type_Body,
      H_C_Type_Default_Value,
      H_C_Type_Spec,
      H_C_Request_Spec,
      H_C_Unmarshall_Body,
      H_C_Unmarshall_Spec,
      H_X_Virtual_Bus,
      H_PN_Cpn_Var,
      H_PN_Interconnection,
      H_PN_To_Delete,
      H_PN_Port_Creation,
      H_PN_Proc_Creation,
      H_RTSJ_Subprogram_Spec,
      H_RTSJ_Subprogram_Body,
      H_RTSJ_Type,
222
      H_RTSJ_Deployment);
223
224
   --  These are tags to precise the meaning of "handle"

225
   type Connection_Pattern_Kind is (Inter_Process, Intra_Process);
226
227
228
229
230
231
232
233
234
235
236
237

   procedure Set_Handling
     (E          : Node_Id;
      Comparison : Comparison_Kind;
      Handling   : Handling_Kind;
      A          : Node_Id);
   --  Set the AADL node E as 'Handling'-handled by 'Comparison' and
   --  the handling result being the Ada node 'A'.

   function Get_Handling
     (E          : Node_Id;
      Comparison : Comparison_Kind;
238
      Handling   : Handling_Kind) return Node_Id;
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
   --  If the AADL node E has been already 'Handling'-handled by
   --  'Comparison', then return the Ada node which is the handling
   --  result. Otherwise, return No_Node.

   procedure Start_Recording_Handlings;
   --  After a call to this procedure. All the new registered handling
   --  will be appended to the internal handling repository.
   --  IMPORTANT NOTE: No consecutive calls to Start_Recording are
   --  allowed.

   procedure Stop_Recording_Handlings;
   --  No more Handlings will be added to the internal handling
   --  repository after the call to this procedure.

   procedure Reset_Handlings;
   --  All the handlings present in the internal handling repository
   --  are reset. The internal handling repository is DEALLOCATED then
   --  REINITIALIZED at the end of the call.

   function Bind_Two_Nodes (N_1 : Node_Id; N_2 : Node_Id) return Node_Id;
   --  Bind the couple of given nodes to a newly created node. The
   --  firts call of this function to a couple of nodes will create a
   --  new binding node. The further calls will return the node
   --  created at the first call.

264
   procedure Bind_Transport_API (P : Node_Id; T : Supported_Transport_APIs);
265
266
   --  Create a link between the process instance P and the transport layer T

267
   function Fetch_Transport_API (P : Node_Id) return Supported_Transport_APIs;
268
269
270
271
272
273
274
275
276
277
278
279
   --  Fetch a transport layer bound using 'Bind_Transport_API'

   function Map_Ada_Subprogram_Spec (S : Node_Id) return Node_Id;
   --  Create an Ada subprogram specification from the AADL subprogram
   --  instance S.

   function Map_Ada_Subprogram_Body (S : Node_Id) return Node_Id;
   --  Create an Ada subprogram body from the AADL subprogram instance
   --  S.

   function Map_Ada_Call_Seq_Subprogram_Spec
     (Spg : Node_Id;
280
      Seq : Node_Id) return Node_Id;
281
282
283
284
285
   --  Create the spec of the subprogram generated for a call sequence
   --  of a hybrid subprogram.

   function Map_Ada_Call_Seq_Subprogram_Body
     (Spg : Node_Id;
286
      Seq : Node_Id) return Node_Id;
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
   --  Create the body of the subprogram generated for a call sequence
   --  of a hybrid subprogram.

   function Map_Ada_Call_Seq_Access (S : Node_Id) return Node_Id;
   --  Map an access type declaration for a subprogram mapped from a
   --  call sequence of the hybrid subprogram S.

   function Map_Ada_Subprogram_Status (S : Node_Id) return Node_Id;
   --  Create an Ada record definition corresponding to the status of
   --  a hybrid AADL subprogram instance.

   function Map_Ada_Data_Type_Designator (E : Node_Id) return Node_Id;
   --  Fetch the Ada type corresponding to the data component instance
   --  E.

   procedure Handle_Call_Sequence
     (Caller       : Node_Id;
      Caller_State : Node_Id;
      Call_Seq     : Node_Id;
      Declarations : List_Id;
      Statements   : List_Id);
   --  This procedure generate the Ada code corresponding to a call
   --  sequence of a thread or a subprogram. All local variable
   --  declarations will be generated in the Declarations list and all
   --  the subprogram calls will be generated in the Statements
   --  list. These two lists have to be initialized before the call to
   --  this subprogram. Caller_State is the "opaque" variable
   --  representing the internal state of the "Caller" instance. Its
   --  value depends on the nature of "Caller" (Thread,
   --  Subprogram). We prefer to give it to the subprogram to keep it
   --  independant from the backend.

   function Get_Ada_Default_Value (D : Node_Id) return Node_Id;
   --  Return an Ada "default value" for the Ada type mapped from the
   --  data component instance D.

   function Map_Ada_Full_Parameter_Name
     (Spg    : Node_Id;
      P      : Node_Id;
326
      Suffix : Character := ASCII.NUL) return Name_Id;
327
328
329
330
331
332
333
   --  Maps a name by concatening the subprogram instance full Spg
   --  name to the parameter instance P name (separated by '_') and
   --  verifying that the resulting name is an Ada-valid identifier
   --  name.

   function Map_Ada_Full_Feature_Name
     (E      : Node_Id;
334
      Suffix : Character := ASCII.NUL) return Name_Id;
335
336
337
338
339
340
341
   --  Maps a name by concatening the full name of the feature
   --  instance E and to Suffix (separated by '_') and verifying that
   --  the resulting name is an Ada-valid identifier name. Any root
   --  system name will be troncated.

   function Map_Ada_Enumerator_Name
     (E      : Node_Id;
342
      Server : Boolean := False) return Name_Id;
343
344
345
346
347
348
   --  Maps an Ada-valid enumerator name from the component or
   --  subcomponent instance E. If Server is True, appends the _Server
   --  suffix to the enumerator identifier.

   function Map_Ada_Defining_Identifier
     (A      : Node_Id;
349
      Suffix : String := "") return Node_Id;
350
351
   function Map_Ada_Defining_Identifier
     (A      : Node_Id;
352
      Suffix : String := "") return Name_Id;
353
354
355
356
357
358
359
360
361
362
   --  Maps an Ada-valid defining identifier form the name of the
   --  given AADL entity. If suffix is not nul, concat it to the
   --  obtained name and separate them by a '_'.

   function Map_Ada_Component_Name (F : Node_Id) return Name_Id;
   --  Maps a name corresponding to a component corresponding to an
   --  [event] data port in a thread interface.

   function Map_Ada_Protected_Aggregate_Identifier
     (S : Node_Id;
363
      A : Node_Id) return Node_Id;
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
   --  Maps an identifier corresponding to the subcomponent A of the
   --  required data S.

   function Map_Ada_Default_Value_Identifier (D : Node_Id) return Node_Id;
   --  Maps an identifier for the default value variable corresponding
   --  to the AADL data component instance D.

   function Map_Ada_Package_Identifier (E : Node_Id) return Node_Id;
   --  Maps an identifier for the package instantiation corresponding
   --  to IN port or Bounded string data type E

   function Map_Ada_Subprogram_Identifier (E : Node_Id) return Node_Id;
   function Map_Ada_Subprogram_Identifier (N : Name_Id) return Node_Id;
   --  Return a node that designate the implementation subprogram
   --  corresponding to the entity instance E. E is either a thread,
   --  subprogram or a port instance. If a 'with' clause is necessary,
   --  this subprogram add it.

   function Map_Ada_Namespace_Defining_Identifier
     (N      : Node_Id;
384
      Prefix : String := "") return Node_Id;
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
   --  Creates an Ada defining identifier corresponding to the
   --  namespace instance E. The parent unit names of the Identifier
   --  are correctly placed depending on the namespace hierarchy. If
   --  'Prefix' is specified, then all the full name is prefixed by
   --  it.

   function To_Bytes (S : Size_Type) return Unsigned_Long_Long;
   --  Converts the given size S into bytes and return it. If the size
   --  cannot be converted into byte, then return 0.

   function To_Bits (S : Size_Type) return Unsigned_Long_Long;
   --  Converts the given size S into bits and return it

   procedure Check_Connection_Consistency (C : Node_Id);
   --  Perform some legality rules check on the connection instance S
   --  and raises an error if one of these rules is broken. See the
   --  comments in the body for more detail on the checked rules.

   procedure Check_Thread_Consistency (T : Node_Id);
   --  Check the thread consistency and raises an error if something
   --  is wrong (Unknown implementation kind).

   function Get_Subcomponent_Access_Source (S : Node_Id) return Node_Id;
   --  Return the source subcomponent of the required subprogram
   --  access S. Raises an error if S is not connected to any source.

   function Get_First_Processor (P : Node_Id) return Node_Id;
   --  Return the first processor of an AADL model

414
415
   function Get_Connection_Pattern
     (E : Node_Id) return Connection_Pattern_Kind;
416
417
   --  Return the connection pattern for a port

418
   function "<=" (T1 : Time_Type; T2 : Time_Type) return Boolean;
419
420
421
422
423
   --  Compare two times. Returns true if the first value is less than
   --  the second value.

   function To_Seconds (S : Time_Type) return Long_Double;
   function To_Milliseconds (S : Time_Type) return Unsigned_Long_Long;
yoogx's avatar
yoogx committed
424
   function To_Nanoseconds (S : Time_Type) return Unsigned_Long_Long;
425
426
427
428
429
430
431

   function Get_Accessed_Data (Data_Access : Node_Id) return Node_Id;
   --  Get accessed data when a thread or subprogram has a data access.

   function Is_Protected_Data (Data_Component : Node_Id) return Boolean;
   --  Indicate if a data should be protected by mutexes/semaphores.

432
433
434
   function Get_Port_By_Name
     (Port      : Node_Id;
      Component : Node_Id) return Node_Id;
435
436
437
438
439
440
441
442
443
444
445
446
447
   --  Returns a port in Component parameter that has the same
   --  name of the Port parameter.

   function Is_Virtual (Port : Node_Id) return Boolean;
   --  Returns True is the port is virtual. Used by the POK
   --  backend only.

   function Get_Associated_Virtual_Buses (Port : Node_Id) return List_Id;
   --  Returns a list that contains virtual bus components bound
   --  to a port. Returns elements that are stored in the DECLARATIVE model
   --  and takes a port that is stored in the INSTANCE model.

   function Look_For_Property_In_Declarative
448
449
     (Component     : Node_Id;
      Property_Name : String) return Node_Id;
450
451
452
453
454
455
   --  Look_For_Property_In_Declarative is just a function that
   --  browses a component and its inherited/refined components
   --  and look for a particular property. It is just a function
   --  that is used to bypass bugs on properties in the instance model.

   function Look_For_Subcomponent_In_Declarative
456
457
     (Component         : Node_Id;
      Subcomponent_Name : String) return Node_Id;
458
459
460
461
462
463
464
465
466
467
468
469
470
   --  Look_For_Subcomponent_In_Declarative search a subcomponent
   --  named like Subcomponent_Name in Component. It returns a Node_Id
   --  with the subcomponent if it exists or return No_Node if it fails.
   --  This function is more a workaround to handle errors in the
   --  instance model.

   function Is_Pure_Device_Port (Port : Node_Id) return Boolean;
   --  Is_Pure_Device_Port returns True if the port is
   --  a pure device port. A pure device port is a port located
   --  in a device that communicates with another device.
   --  Port is a node in the instance model.

   function Get_Instance_Type_Associated_With_Virtual_Bus
471
     (Port : Node_Id) return Node_Id;
472
473
474
475
476
477
478
   --  Returns the instance component of the data associated with
   --  a virtual bus.

   function Is_Using_Virtual_Bus (Port : Node_Id) return Boolean;
   --  Indicate is an inter-partition port should use
   --  virtual bus mechanisms, browsing the components hierarchy.

479
480
   function Get_Corresponding_Port_In_Component
     (Port : Node_Id) return Node_Id;
481
482
   --  Return the port connected the port given in parameter
   --  inside the component.
483

484
485
   function Process_Use_Defaults_Sockets
     (The_Process : Node_Id) return Boolean;
486
487

   function Get_Associated_Bus (Port : Node_Id) return Node_Id;
488

Julien's avatar
Julien committed
489
490
491
492
   function Find_Associated_Process (Runtime       : Node_Id;
                                     Root_Node     : Node_Id := No_Node)
                                     return Node_Id;

493
end Ocarina.Backends.Utils;