aboutsummaryrefslogtreecommitdiffstats
path: root/gcc-4.8.3/gcc/ada/exp_disp.ads
diff options
context:
space:
mode:
Diffstat (limited to 'gcc-4.8.3/gcc/ada/exp_disp.ads')
-rw-r--r--gcc-4.8.3/gcc/ada/exp_disp.ads394
1 files changed, 394 insertions, 0 deletions
diff --git a/gcc-4.8.3/gcc/ada/exp_disp.ads b/gcc-4.8.3/gcc/ada/exp_disp.ads
new file mode 100644
index 000000000..f95fba5ad
--- /dev/null
+++ b/gcc-4.8.3/gcc/ada/exp_disp.ads
@@ -0,0 +1,394 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT COMPILER COMPONENTS --
+-- --
+-- E X P _ D I S P --
+-- --
+-- S p e c --
+-- --
+-- Copyright (C) 1992-2012, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it 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. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT 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 GNAT; see file COPYING3. If not, go to --
+-- http://www.gnu.org/licenses for a complete copy of the license. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+-- This package contains routines involved in tagged types and dynamic
+-- dispatching expansion.
+
+with Types; use Types;
+
+package Exp_Disp is
+
+ -------------------------------------
+ -- Predefined primitive operations --
+ -------------------------------------
+
+ -- The predefined primitive operations (PPOs) are subprograms generated
+ -- by GNAT for a particular tagged type. Their role is to provide support
+ -- for different Ada language features such as the attribute 'Size or
+ -- handling of dispatching triggers in select statements. PPOs are created
+ -- when a tagged type is expanded or frozen. These subprograms are later
+ -- collected and inserted into the dispatch table of a tagged type at
+ -- fixed positions. Some of the PPOs that manipulate data in tagged objects
+ -- require the generation of thunks.
+
+ -- List of predefined primitive operations
+
+ -- Leading underscores designate reserved names. Bracketed numerical
+ -- values represent dispatch table slot numbers.
+
+ -- _Size (1) - implementation of the attribute 'Size for any tagged
+ -- type. Constructs of the form Prefix'Size are converted into
+ -- Prefix._Size.
+
+ -- TSS_Stream_Read (2) - implementation of the stream attribute Read
+ -- for any tagged type.
+
+ -- TSS_Stream_Write (3) - implementation of the stream attribute Write
+ -- for any tagged type.
+
+ -- TSS_Stream_Input (4) - implementation of the stream attribute Input
+ -- for any tagged type.
+
+ -- TSS_Stream_Output (5) - implementation of the stream attribute
+ -- Output for any tagged type.
+
+ -- Op_Eq (6) - implementation of the equality operator for any non-
+ -- limited tagged type.
+
+ -- _Assign (7) - implementation of the assignment operator for any
+ -- non-limited tagged type.
+
+ -- TSS_Deep_Adjust (8) - implementation of the finalization operation
+ -- Adjust for any non-limited tagged type.
+
+ -- TSS_Deep_Finalize (9) - implementation of the finalization
+ -- operation Finalize for any non-limited tagged type.
+
+ -- _Disp_Asynchronous_Select (10) - used in the expansion of ATC with
+ -- dispatching triggers. Null implementation for limited interfaces,
+ -- full body generation for types that implement limited interfaces,
+ -- not generated for the rest of the cases. See Expand_N_Asynchronous_
+ -- Select in Exp_Ch9 for more information.
+
+ -- _Disp_Conditional_Select (11) - used in the expansion of conditional
+ -- selects with dispatching triggers. Null implementation for limited
+ -- interfaces, full body generation for types that implement limited
+ -- interfaces, not generated for the rest of the cases. See Expand_N_
+ -- Conditional_Entry_Call in Exp_Ch9 for more information.
+
+ -- _Disp_Get_Prim_Op_Kind (12) - helper routine used in the expansion
+ -- of ATC with dispatching triggers. Null implementation for limited
+ -- interfaces, full body generation for types that implement limited
+ -- interfaces, not generated for the rest of the cases.
+
+ -- _Disp_Get_Task_Id (13) - helper routine used in the expansion of
+ -- Abort, attributes 'Callable and 'Terminated for task interface
+ -- class-wide types. Full body generation for task types, null
+ -- implementation for limited interfaces, not generated for the rest
+ -- of the cases. See Expand_N_Attribute_Reference in Exp_Attr and
+ -- Expand_N_Abort_Statement in Exp_Ch9 for more information.
+
+ -- _Disp_Requeue (14) - used in the expansion of dispatching requeue
+ -- statements. Null implementation is provided for protected, task
+ -- and synchronized interfaces. Protected and task types implementing
+ -- concurrent interfaces receive full bodies. See Expand_N_Requeue_
+ -- Statement in Exp_Ch9 for more information.
+
+ -- _Disp_Timed_Select (15) - used in the expansion of timed selects
+ -- with dispatching triggers. Null implementation for limited
+ -- interfaces, full body generation for types that implement limited
+ -- interfaces, not generated for the rest of the cases. See Expand_N_
+ -- Timed_Entry_Call for more information.
+
+ -- Life cycle of predefined primitive operations
+
+ -- The specifications and bodies of the PPOs are created by
+ -- Make_Predefined_Primitive_Specs and Predefined_Primitive_Bodies
+ -- in Exp_Ch3. The generated specifications are immediately analyzed,
+ -- while the bodies are left as freeze actions to the tagged type for
+ -- which they are created.
+
+ -- PPOs are collected and added to the Primitive_Operations list of
+ -- a type by the regular analysis mechanism.
+
+ -- PPOs are frozen by Exp_Ch3.Predefined_Primitive_Freeze
+
+ -- Thunks for PPOs are created by Make_DT
+
+ -- Dispatch table positions of PPOs are set by Set_All_DT_Position
+
+ -- Calls to PPOs proceed as regular dispatching calls. If the PPO
+ -- has a thunk, a call proceeds as a regular dispatching call with
+ -- a thunk.
+
+ -- Guidelines for addition of new predefined primitive operations
+
+ -- Update the value of constant Max_Predef_Prims in a-tags.ads to
+ -- indicate the new number of PPOs.
+
+ -- Introduce a new predefined name for the new PPO in Snames.ads and
+ -- Snames.adb.
+
+ -- Categorize the new PPO name as predefined by adding an entry in
+ -- Is_Predefined_Dispatching_Operation in Exp_Disp.
+
+ -- Generate the specification of the new PPO in Make_Predefined_
+ -- Primitive_Spec in Exp_Ch3.adb. The Is_Internal flag of the defining
+ -- identifier of the specification must be set to True.
+
+ -- Generate the body of the new PPO in Predefined_Primitive_Bodies in
+ -- Exp_Ch3.adb. The Is_Internal flag of the defining identifier of the
+ -- specification must be set to True.
+
+ -- If the new PPO requires a thunk, add an entry in Freeze_Subprogram
+ -- in Exp_Ch6.adb.
+
+ -- When generating calls to a PPO, use Find_Prim_Op from Exp_Util.ads
+ -- to retrieve the entity of the operation directly.
+
+ -- Number of predefined primitive operations added by the Expander
+ -- for a tagged type. If more predefined primitive operations are
+ -- added, the following items must be changed:
+
+ -- Ada.Tags.Max_Predef_Prims - indirect use
+ -- Exp_Disp.Default_Prim_Op_Position - indirect use
+ -- Exp_Disp.Set_All_DT_Position - direct use
+
+ procedure Apply_Tag_Checks (Call_Node : Node_Id);
+ -- Generate checks required on dispatching calls
+
+ function Building_Static_DT (Typ : Entity_Id) return Boolean;
+ pragma Inline (Building_Static_DT);
+ -- Returns true when building statically allocated dispatch tables
+
+ procedure Build_Static_Dispatch_Tables (N : Node_Id);
+ -- N is a library level package declaration or package body. Build the
+ -- static dispatch table of the tagged types defined at library level. In
+ -- case of package declarations with private part the generated nodes are
+ -- added at the end of the list of private declarations. Otherwise they are
+ -- added to the end of the list of public declarations. In case of package
+ -- bodies they are added to the end of the list of declarations of the
+ -- package body.
+
+ function Convert_Tag_To_Interface
+ (Typ : Entity_Id; Expr : Node_Id) return Node_Id;
+ pragma Inline (Convert_Tag_To_Interface);
+ -- This function is used in class-wide interface conversions; the expanded
+ -- code generated to convert a tagged object to a class-wide interface type
+ -- involves referencing the tag component containing the secondary dispatch
+ -- table associated with the interface. Given the expression Expr that
+ -- references a tag component, we cannot generate an unchecked conversion
+ -- to leave the expression decorated with the class-wide interface type Typ
+ -- because an unchecked conversion cannot be seen as a no-op. An unchecked
+ -- conversion is conceptually a function call and therefore the RM allows
+ -- the backend to obtain a copy of the value of the actual object and store
+ -- it in some other place (like a register); in such case the interface
+ -- conversion is not equivalent to a displacement of the pointer to the
+ -- interface and any further displacement fails. Although the functionality
+ -- of this function is simple and could be done directly, the purpose of
+ -- this routine is to leave well documented in the sources these
+ -- occurrences.
+
+ -- If Expr is an N_Selected_Component that references a tag generate:
+ -- type ityp is non null access Typ;
+ -- ityp!(Expr'Address).all
+
+ -- if Expr is an N_Function_Call to Ada.Tags.Displace then generate:
+ -- type ityp is non null access Typ;
+ -- ityp!(Expr).all
+
+ function CPP_Num_Prims (Typ : Entity_Id) return Nat;
+ -- Return the number of primitives of the C++ part of the dispatch table.
+ -- For types that are not derivations of CPP types return 0.
+
+ procedure Expand_Dispatching_Call (Call_Node : Node_Id);
+ -- Expand the call to the operation through the dispatch table and perform
+ -- the required tag checks when appropriate. For CPP types tag checks are
+ -- not relevant.
+
+ procedure Expand_Interface_Actuals (Call_Node : Node_Id);
+ -- Ada 2005 (AI-251): Displace all the actuals corresponding to class-wide
+ -- interfaces to reference the interface tag of the actual object
+
+ procedure Expand_Interface_Conversion
+ (N : Node_Id;
+ Is_Static : Boolean := True);
+ -- Ada 2005 (AI-251): N is a type-conversion node. Reference the base of
+ -- the object to give access to the interface tag associated with the
+ -- secondary dispatch table.
+
+ procedure Expand_Interface_Thunk
+ (Prim : Node_Id;
+ Thunk_Id : out Entity_Id;
+ Thunk_Code : out Node_Id);
+ -- Ada 2005 (AI-251): When a tagged type implements abstract interfaces we
+ -- generate additional subprograms (thunks) associated with each primitive
+ -- Prim to have a layout compatible with the C++ ABI. The thunk displaces
+ -- the pointers to the actuals that depend on the controlling type before
+ -- transferring control to the target subprogram. If there is no need to
+ -- generate the thunk then Thunk_Id and Thunk_Code are set to Empty.
+ -- Otherwise they are set to the defining identifier and the subprogram
+ -- body of the generated thunk.
+
+ function Has_CPP_Constructors (Typ : Entity_Id) return Boolean;
+ -- Returns true if the type has CPP constructors
+
+ function Is_Expanded_Dispatching_Call (N : Node_Id) return Boolean;
+ -- Returns true if N is the expanded code of a dispatching call
+
+ function Is_Predefined_Dispatching_Operation (E : Entity_Id) return Boolean;
+ -- Ada 2005 (AI-251): Determines if E is a predefined primitive operation
+
+ function Is_Predefined_Internal_Operation (E : Entity_Id) return Boolean;
+ -- Similar to the previous one, but excludes stream operations, because
+ -- these may be overridden, and need extra formals, like user-defined
+ -- operations.
+
+ function Is_Predefined_Interface_Primitive (E : Entity_Id) return Boolean;
+ -- Ada 2005 (AI-345): Returns True if E is one of the predefined primitives
+ -- required to implement interfaces.
+
+ function Make_DT (Typ : Entity_Id; N : Node_Id := Empty) return List_Id;
+ -- Expand the declarations for the Dispatch Table. The node N is the
+ -- declaration that forces the generation of the table. It is used to place
+ -- error messages when the declaration leads to the freezing of a given
+ -- primitive operation that has an incomplete non- tagged formal.
+
+ function Make_Disp_Asynchronous_Select_Body
+ (Typ : Entity_Id) return Node_Id;
+ -- Ada 2005 (AI-345): Generate the body of the primitive operation of type
+ -- Typ used for dispatching in asynchronous selects. Generate a null body
+ -- if Typ is an interface type.
+
+ function Make_Disp_Asynchronous_Select_Spec
+ (Typ : Entity_Id) return Node_Id;
+ -- Ada 2005 (AI-345): Generate the specification of the primitive operation
+ -- of type Typ used for dispatching in asynchronous selects.
+
+ function Make_Disp_Conditional_Select_Body
+ (Typ : Entity_Id) return Node_Id;
+ -- Ada 2005 (AI-345): Generate the body of the primitive operation of type
+ -- Typ used for dispatching in conditional selects. Generate a null body
+ -- if Typ is an interface type.
+
+ function Make_Disp_Conditional_Select_Spec
+ (Typ : Entity_Id) return Node_Id;
+ -- Ada 2005 (AI-345): Generate the specification of the primitive operation
+ -- of type Typ used for dispatching in conditional selects.
+
+ function Make_Disp_Get_Prim_Op_Kind_Body
+ (Typ : Entity_Id) return Node_Id;
+ -- Ada 2005 (AI-345): Generate the body of the primitive operation of type
+ -- Typ used for retrieving the callable entity kind during dispatching in
+ -- asynchronous selects. Generate a null body if Typ is an interface type.
+
+ function Make_Disp_Get_Prim_Op_Kind_Spec
+ (Typ : Entity_Id) return Node_Id;
+ -- Ada 2005 (AI-345): Generate the specification of the primitive operation
+ -- of the type Typ use for retrieving the callable entity kind during
+ -- dispatching in asynchronous selects.
+
+ function Make_Disp_Get_Task_Id_Body
+ (Typ : Entity_Id) return Node_Id;
+ -- Ada 2005 (AI-345): Generate body of the primitive operation of type Typ
+ -- used for retrieving the _task_id field of a task interface class- wide
+ -- type. Generate a null body if Typ is an interface or a non-task type.
+
+ function Make_Disp_Get_Task_Id_Spec
+ (Typ : Entity_Id) return Node_Id;
+ -- Ada 2005 (AI-345): Generate the specification of the primitive operation
+ -- of type Typ used for retrieving the _task_id field of a task interface
+ -- class-wide type.
+
+ function Make_Disp_Requeue_Body
+ (Typ : Entity_Id) return Node_Id;
+ -- Ada 2005 (AI05-0030): Generate the body of the primitive operation of
+ -- type Typ used for dispatching on requeue statements. Generate a body
+ -- containing a single null-statement if Typ is an interface type.
+
+ function Make_Disp_Requeue_Spec
+ (Typ : Entity_Id) return Node_Id;
+ -- Ada 2005 (AI05-0030): Generate the specification of the primitive
+ -- operation of type Typ used for dispatching requeue statements.
+
+ function Make_Disp_Timed_Select_Body
+ (Typ : Entity_Id) return Node_Id;
+ -- Ada 2005 (AI-345): Generate the body of the primitive operation of type
+ -- Typ used for dispatching in timed selects. Generate a body containing
+ -- a single null-statement if Typ is an interface type.
+
+ function Make_Disp_Timed_Select_Spec
+ (Typ : Entity_Id) return Node_Id;
+ -- Ada 2005 (AI-345): Generate the specification of the primitive operation
+ -- of type Typ used for dispatching in timed selects.
+
+ function Make_Select_Specific_Data_Table
+ (Typ : Entity_Id) return List_Id;
+ -- Ada 2005 (AI-345): Create and populate the auxiliary table in the TSD
+ -- of Typ used for dispatching in asynchronous, conditional and timed
+ -- selects. Generate code to set the primitive operation kinds and entry
+ -- indexes of primitive operations and primitive wrappers.
+
+ function Make_Tags (Typ : Entity_Id) return List_Id;
+ -- Generate the entities associated with the primary and secondary tags of
+ -- Typ and fill the contents of Access_Disp_Table. In case of library level
+ -- tagged types this routine imports the forward declaration of the tag
+ -- entity, that will be declared and exported by Make_DT.
+
+ function Make_VM_TSD (Typ : Entity_Id) return List_Id;
+ -- Build the Type Specific Data record associated with tagged type Typ.
+ -- Invoked only when generating code for VM targets.
+
+ function Register_Primitive
+ (Loc : Source_Ptr;
+ Prim : Entity_Id) return List_Id;
+ -- Build code to register Prim in the primary or secondary dispatch table.
+ -- If Prim is associated with a secondary dispatch table then generate also
+ -- its thunk and register it in the associated secondary dispatch table.
+ -- In general the dispatch tables are always generated by Make_DT and
+ -- Make_Secondary_DT; this routine is only used in two corner cases:
+ --
+ -- 1) To construct the dispatch table of a tagged type whose parent
+ -- is a CPP_Class (see Build_Init_Procedure).
+ -- 2) To handle late overriding of dispatching operations (see
+ -- Check_Dispatching_Operation and Make_DT).
+ --
+ -- The caller is responsible for inserting the generated code in the
+ -- proper place.
+
+ procedure Set_All_DT_Position (Typ : Entity_Id);
+ -- Set the DT_Position field for each primitive operation. In the CPP
+ -- Class case check that no pragma CPP_Virtual is missing and that the
+ -- DT_Position are coherent
+
+ procedure Set_CPP_Constructors (Typ : Entity_Id);
+ -- Typ is a CPP_Class type. Create the Init procedures of that type
+ -- required to handle its default and non-default constructors. The
+ -- functions to which pragma CPP_Constructor is applied in the sources
+ -- are functions returning this type, and having an implicit access to the
+ -- target object in its first argument; such implicit argument is explicit
+ -- in the IP procedures built here.
+
+ procedure Set_DTC_Entity_Value
+ (Tagged_Type : Entity_Id;
+ Prim : Entity_Id);
+ -- Set the definite value of the DTC_Entity value associated with a given
+ -- primitive of a tagged type.
+
+ procedure Write_DT (Typ : Entity_Id);
+ pragma Export (Ada, Write_DT);
+ -- Debugging procedure (to be called within gdb)
+
+end Exp_Disp;