ocarina-backends-utils.ads 20.9 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 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25
--    Copyright (C) 2005-2009 Telecom ParisTech, 2010-2015 ESA & ISAE.      --
--                                                                          --
-- 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 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
--                                                                          --
------------------------------------------------------------------------------

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 --
   ----------

66 67 68
   function Normalize_Name
     (Name      : Name_Id;
      Ada_Style : Boolean := False) return Name_Id;
69 70 71 72
   --  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 "__"

73 74 75 76 77 78
   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

79 80 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
   -----------------------------------------------------
   -- 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.

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

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

139
   function Get_Destination_Ports
140 141
     (P             : Node_Id;
      Custom_Parent : Node_Id := No_Node) return List_Id;
142 143 144 145 146 147
   --  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.
148 149
   --  Note: the list may be empty in the case of an event out port
   --  connected to a port that triggers a mode change.
150 151 152 153 154 155 156 157 158

   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
159 160
   --  subprogram call or thread instance E, return No_Node if it
   --  cannot be determined.
161 162 163 164 165 166

   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
167 168
     (Bus     : Node_Id;
      Process : Node_Id) return Node_Id;
169 170
   --  Return the device the allows access to Process through Bus

171
   function Is_Connected (Bus : Node_Id; Device : Node_Id) return Boolean;
172 173 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
   --  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,
220
      H_RTSJ_Deployment);
221 222
   --  These are tags to precise the meaning of "handle"

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

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

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

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

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

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

   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.

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

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

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

   function Get_Associated_Bus (Port : Node_Id) return Node_Id;
486

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

491 492 493 494 495 496 497
   function Get_Partition_Runtime (Process    : Node_Id;
                                   Root_Node  : Node_Id := No_Node)
                                     return Node_Id;

   function Get_Root_Component (C : Node_Id)
                               return Node_Id;

498
end Ocarina.Backends.Utils;