ocarina-backends-utils.ads 20.6 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

489
end Ocarina.Backends.Utils;