| ------------------------------------------------------------------------------ |
| -- -- |
| -- GNAT COMPILER COMPONENTS -- |
| -- -- |
| -- E X P _ A T A G -- |
| -- -- |
| -- S p e c -- |
| -- -- |
| -- Copyright (C) 2006-2011, 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 the frontend expansion of |
| -- subprograms of package Ada.Tags |
| |
| with Types; use Types; |
| with Uintp; use Uintp; |
| |
| package Exp_Atag is |
| |
| -- Note: In all the subprograms of this package formal 'Loc' is the source |
| -- location used in constructing the corresponding nodes. |
| |
| procedure Build_Common_Dispatching_Select_Statements |
| (Typ : Entity_Id; |
| Stmts : List_Id); |
| -- Ada 2005 (AI-345): Build statements that are common to the expansion of |
| -- timed, asynchronous, and conditional select and append them to Stmts. |
| -- Typ is the tagged type used for dispatching calls. |
| |
| procedure Build_CW_Membership |
| (Loc : Source_Ptr; |
| Obj_Tag_Node : in out Node_Id; |
| Typ_Tag_Node : Node_Id; |
| Related_Nod : Node_Id; |
| New_Node : out Node_Id); |
| -- Build code that returns true if Obj_Tag is in Typ_Tag'Class. Each DT |
| -- has a table of ancestors and its inheritance level (Idepth). Obj is in |
| -- Typ'Class if Typ'Tag is found in the table of ancestors referenced by |
| -- Obj'Tag. Knowing the level of inheritance of both types, this can be |
| -- computed in constant time by the formula: |
| -- |
| -- Index := TSD (Obj'Tag).Idepth - TSD (Typ'Tag).Idepth; |
| -- Index > 0 and then TSD (Obj'Tag).Tags_Table (Index) = Typ'Tag |
| -- |
| -- Related_Nod is the node where the implicit declaration of variable Index |
| -- is inserted. Obj_Tag_Node is relocated. |
| |
| function Build_Get_Access_Level |
| (Loc : Source_Ptr; |
| Tag_Node : Node_Id) return Node_Id; |
| -- Build code that retrieves the accessibility level of the tagged type. |
| -- |
| -- Generates: TSD (Tag).Access_Level |
| |
| function Build_Get_Alignment |
| (Loc : Source_Ptr; |
| Tag_Node : Node_Id) return Node_Id; |
| -- Build code that retrieves the alignment of the tagged type. |
| -- Generates: TSD (Tag).Alignment |
| |
| procedure Build_Get_Predefined_Prim_Op_Address |
| (Loc : Source_Ptr; |
| Position : Uint; |
| Tag_Node : in out Node_Id; |
| New_Node : out Node_Id); |
| -- Given a pointer to a dispatch table (T) and a position in the DT, build |
| -- code that gets the address of the predefined virtual function stored in |
| -- it (used for dispatching calls). Tag_Node is relocated. |
| -- |
| -- Generates: Predefined_DT (Tag).D (Position); |
| |
| procedure Build_Get_Prim_Op_Address |
| (Loc : Source_Ptr; |
| Typ : Entity_Id; |
| Position : Uint; |
| Tag_Node : in out Node_Id; |
| New_Node : out Node_Id); |
| -- Build code that retrieves the address of the virtual function stored in |
| -- a given position of the dispatch table (used for dispatching calls). |
| -- Tag_Node is relocated. |
| -- |
| -- Generates: To_Tag (Tag).D (Position); |
| |
| function Build_Get_Transportable |
| (Loc : Source_Ptr; |
| Tag_Node : Node_Id) return Node_Id; |
| -- Build code that retrieves the value of the Transportable flag for |
| -- the given Tag. |
| -- |
| -- Generates: TSD (Tag).Transportable; |
| |
| function Build_Inherit_CPP_Prims (Typ : Entity_Id) return List_Id; |
| -- Build code that copies from Typ's parent the dispatch table slots of |
| -- inherited primitives and updates slots of overridden primitives. The |
| -- generated code handles primary and secondary dispatch tables of Typ. |
| |
| function Build_Inherit_Predefined_Prims |
| (Loc : Source_Ptr; |
| Old_Tag_Node : Node_Id; |
| New_Tag_Node : Node_Id) return Node_Id; |
| -- Build code that inherits the predefined primitives of the parent. |
| -- |
| -- Generates: Predefined_DT (New_T).D (All_Predefined_Prims) := |
| -- Predefined_DT (Old_T).D (All_Predefined_Prims); |
| -- |
| -- Required to build non-library level dispatch tables. Also required |
| -- when compiling without static dispatch tables support. |
| |
| function Build_Inherit_Prims |
| (Loc : Source_Ptr; |
| Typ : Entity_Id; |
| Old_Tag_Node : Node_Id; |
| New_Tag_Node : Node_Id; |
| Num_Prims : Nat) return Node_Id; |
| -- Build code that inherits Num_Prims user-defined primitives from the |
| -- dispatch table of the parent type of tagged type Typ. It is used to |
| -- copy the dispatch table of the parent in the following cases: |
| -- a) case of derivations of CPP_Class types |
| -- b) tagged types whose dispatch table is not statically allocated |
| -- |
| -- Generates: |
| -- New_Tag.Prims_Ptr (1 .. Num_Prims) := |
| -- Old_Tag.Prims_Ptr (1 .. Num_Prims); |
| |
| function Build_Offset_To_Top |
| (Loc : Source_Ptr; |
| This_Node : Node_Id) return Node_Id; |
| -- Build code that references the Offset_To_Top component of the primary |
| -- or secondary dispatch table associated with This_Node. This subprogram |
| -- provides a subset of the functionality provided by the function |
| -- Offset_To_Top of package Ada.Tags, and is only called by the frontend |
| -- when such routine is not available in a configurable runtime. |
| -- |
| -- Generates: |
| -- Offset_To_Top_Ptr |
| -- (Address!(Tag_Ptr!(This).all) - Offset_To_Top_Offset) |
| |
| function Build_Set_Predefined_Prim_Op_Address |
| (Loc : Source_Ptr; |
| Tag_Node : Node_Id; |
| Position : Uint; |
| Address_Node : Node_Id) return Node_Id; |
| -- Build code that saves the address of a virtual function in a given |
| -- Position of the portion of the dispatch table associated with the |
| -- predefined primitives of Tag. Called from Exp_Disp.Fill_DT_Entry |
| -- and Exp_Disp.Fill_Secondary_DT_Entry. It is used for: |
| -- 1) Filling the dispatch table of CPP_Class types. |
| -- 2) Late overriding (see Check_Dispatching_Operation). |
| -- |
| -- Generates: Predefined_DT (Tag).D (Position) := Value |
| |
| function Build_Set_Prim_Op_Address |
| (Loc : Source_Ptr; |
| Typ : Entity_Id; |
| Tag_Node : Node_Id; |
| Position : Uint; |
| Address_Node : Node_Id) return Node_Id; |
| -- Build code that saves the address of a virtual function in a given |
| -- Position of the dispatch table associated with the Tag. Called from |
| -- Exp_Disp.Fill_DT_Entry and Exp_Disp.Fill_Secondary_DT_Entry. Used for: |
| -- 1) Filling the dispatch table of CPP_Class types. |
| -- 2) Late overriding (see Check_Dispatching_Operation). |
| -- |
| -- Generates: Tag.D (Position) := Value |
| |
| function Build_Set_Size_Function |
| (Loc : Source_Ptr; |
| Tag_Node : Node_Id; |
| Size_Func : Entity_Id) return Node_Id; |
| -- Build code that saves in the TSD the address of the function |
| -- calculating _size of the object. |
| |
| function Build_Set_Static_Offset_To_Top |
| (Loc : Source_Ptr; |
| Iface_Tag : Node_Id; |
| Offset_Value : Node_Id) return Node_Id; |
| -- Build code that initialize the Offset_To_Top component of the |
| -- secondary dispatch table referenced by Iface_Tag. |
| -- |
| -- Generates: |
| -- Offset_To_Top_Ptr |
| -- (Address!(Tag_Ptr!(This).all) - Offset_To_Top_Offset).all |
| -- := Offset_Value |
| |
| end Exp_Atag; |