ocarina-backends-utils.ads 20.8 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-2016 ESA & ISAE.      --
10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25
--                                                                          --
-- Ocarina  is free software; you can redistribute it and/or modify under   --
-- terms of the  GNU General Public License as published  by the Free Soft- --
-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
-- sion. 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.                     --
--                                                                          --
-- As a special exception under Section 7 of GPL version 3, you are granted --
-- additional permissions described in the GCC Runtime Library Exception,   --
-- version 3.1, as published by the Free Software Foundation.               --
--                                                                          --
-- You should have received a copy of the GNU General Public License and    --
-- a copy of the GCC Runtime Library Exception along with this program;     --
-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
-- <http://www.gnu.org/licenses/>.                                          --
26
--                                                                          --
jhugues's avatar
jhugues committed
27 28
--                 Ocarina is maintained by the TASTE project               --
--                      (taste-users@lists.tuxfamily.org)                   --
29 30 31 32 33 34 35 36 37
--                                                                          --
------------------------------------------------------------------------------

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

package Ocarina.Backends.Utils is

   type Browsing_Kind is (By_Source, By_Destination, Default);

38 39 40 41 42 43 44 45 46
   ------------------
   --  AST visitor --
   ------------------

   generic
      with procedure Visit (E : Node_Id);
   procedure Visit_Subcomponents_Of_G (E : Node_Id);
   --  Visit the component instance corresponding to the subcomponents of E

47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74
   --------------------------
   -- 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 --
   ----------

75 76 77
   function Normalize_Name
     (Name      : Name_Id;
      Ada_Style : Boolean := False) return Name_Id;
78 79 80 81
   --  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 "__"

82 83 84 85 86 87
   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

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 121 122 123 124 125 126 127
   -----------------------------------------------------
   -- 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.

128 129 130 131 132 133 134 135
   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.

136 137 138 139 140 141 142 143 144 145 146 147
   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.

148
   function Get_Destination_Ports
149 150
     (P             : Node_Id;
      Custom_Parent : Node_Id := No_Node) return List_Id;
151 152 153 154 155 156
   --  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.
157 158
   --  Note: the list may be empty in the case of an event out port
   --  connected to a port that triggers a mode change.
159 160 161 162 163 164 165 166 167

   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
168 169
   --  subprogram call or thread instance E, return No_Node if it
   --  cannot be determined.
170 171 172 173 174 175

   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
176 177
     (Bus     : Node_Id;
      Process : Node_Id) return Node_Id;
178 179
   --  Return the device the allows access to Process through Bus

180
   function Is_Connected (Bus : Node_Id; Device : Node_Id) return Boolean;
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
   --  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_Subprogram_Body,
      H_Ada_Subprogram_Spec,
      H_Ada_Type_Body,
      H_Ada_Type_Default_Value,
      H_Ada_Type_Spec,
      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,
yoogx's avatar
yoogx committed
221
      H_PN_Proc_Creation);
222 223
   --  These are tags to precise the meaning of "handle"

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

   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;
237
      Handling   : Handling_Kind) return Node_Id;
238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262
   --  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.

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

266
   function Fetch_Transport_API (P : Node_Id) return Supported_Transport_APIs;
267 268 269 270 271 272 273 274 275 276 277 278
   --  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;
279
      Seq : Node_Id) return Node_Id;
280 281 282 283 284
   --  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;
285
      Seq : Node_Id) return Node_Id;
286 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
   --  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;
325
      Suffix : Character := ASCII.NUL) return Name_Id;
326 327 328 329 330 331 332
   --  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;
333
      Suffix : Character := ASCII.NUL) return Name_Id;
334 335 336 337 338 339 340
   --  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;
341
      Server : Boolean := False) return Name_Id;
342 343 344 345 346 347
   --  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;
348
      Suffix : String := "") return Node_Id;
349 350
   function Map_Ada_Defining_Identifier
     (A      : Node_Id;
351
      Suffix : String := "") return Name_Id;
352 353 354 355 356 357 358 359 360 361
   --  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;
362
      A : Node_Id) return Node_Id;
363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382
   --  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;
383
      Prefix : String := "") return Node_Id;
384 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
   --  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

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

417
   function "<=" (T1 : Time_Type; T2 : Time_Type) return Boolean;
418 419 420 421 422
   --  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
423
   function To_Nanoseconds (S : Time_Type) return Unsigned_Long_Long;
424 425 426 427 428 429 430

   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.

431 432 433
   function Get_Port_By_Name
     (Port      : Node_Id;
      Component : Node_Id) return Node_Id;
434 435 436 437 438 439 440 441 442 443 444 445 446
   --  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
447 448
     (Component     : Node_Id;
      Property_Name : String) return Node_Id;
449 450 451 452 453 454
   --  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
455 456
     (Component         : Node_Id;
      Subcomponent_Name : String) return Node_Id;
457 458 459 460 461 462 463 464 465 466 467 468 469
   --  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
470
     (Port : Node_Id) return Node_Id;
471 472 473 474 475 476 477
   --  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.

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

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

   function Get_Associated_Bus (Port : Node_Id) return Node_Id;
487

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

yoogx's avatar
yoogx committed
492 493 494
   function Get_Partition_Runtime
     (Process   : Node_Id;
      Root_Node : Node_Id := No_Node) return Node_Id;
495

yoogx's avatar
yoogx committed
496
   function Get_Root_Component (C : Node_Id) return Node_Id;
497

498 499 500
   function Get_Core_Id (D : Node_Id) return Unsigned_Long_Long;
   --  Return the id of the core D is bound to

501
end Ocarina.Backends.Utils;