1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 2006-2007, Free Software Foundation, Inc. --
11 -- GNAT is free software; you can redistribute it and/or modify it under --
12 -- terms of the GNU General Public License as published by the Free Soft- --
13 -- ware Foundation; either version 2, or (at your option) any later ver- --
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
16 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
17 -- for more details. You should have received a copy of the GNU General --
18 -- Public License distributed with GNAT; see file COPYING. If not, write --
19 -- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
20 -- Boston, MA 02110-1301, USA. --
22 -- GNAT was originally developed by the GNAT team at New York University. --
23 -- Extensive contributions were provided by Ada Core Technologies Inc. --
25 ------------------------------------------------------------------------------
27 -- This package contains routines involved in the frontend expansion of
28 -- subprograms of package Ada.Tags
30 with Types; use Types;
31 with Uintp; use Uintp;
35 -- Note: In all the subprograms of this package formal 'Loc' is the source
36 -- location used in constructing the corresponding nodes.
38 procedure Build_Common_Dispatching_Select_Statements
42 -- Ada 2005 (AI-345): Generate statements that are common between timed,
43 -- asynchronous, and conditional select expansion.
45 function Build_CW_Membership
47 Obj_Tag_Node : Node_Id;
48 Typ_Tag_Node : Node_Id) return Node_Id;
49 -- Build code that returns true if Obj_Tag is in Typ_Tag'Class. Each DT
50 -- has a table of ancestors and its inheritance level (Idepth). Obj is in
51 -- Typ'Class if Typ'Tag is found in the table of ancestors referenced by
52 -- Obj'Tag. Knowing the level of inheritance of both types, this can be
53 -- computed in constant time by the formula:
55 -- TSD (Obj'tag).Tags_Table (TSD (Obj'tag).Idepth - TSD (Typ'tag).Idepth)
58 function Build_Get_Access_Level
60 Tag_Node : Node_Id) return Node_Id;
61 -- Build code that retrieves the accessibility level of the tagged type.
63 -- Generates: TSD (Tag).Access_Level
65 function Build_Get_Predefined_Prim_Op_Address
68 Position : Uint) return Node_Id;
69 -- Given a pointer to a dispatch table (T) and a position in the DT, build
70 -- code that gets the address of the predefined virtual function stored in
71 -- it (used for dispatching calls).
73 -- Generates: Predefined_DT (Tag).D (Position);
75 function Build_Get_Prim_Op_Address
79 Position : Uint) return Node_Id;
80 -- Build code that retrieves the address of the virtual function stored in
81 -- a given position of the dispatch table (used for dispatching calls).
83 -- Generates: To_Tag (Tag).D (Position);
85 function Build_Get_Transportable
87 Tag_Node : Node_Id) return Node_Id;
88 -- Build code that retrieves the value of the Transportable flag for
91 -- Generates: TSD (Tag).Transportable;
93 function Build_Inherit_Predefined_Prims
95 Old_Tag_Node : Node_Id;
96 New_Tag_Node : Node_Id) return Node_Id;
97 -- Build code that inherits the predefined primitives of the parent.
99 -- Generates: Predefined_DT (New_T).D (All_Predefined_Prims) :=
100 -- Predefined_DT (Old_T).D (All_Predefined_Prims);
102 -- Required to build the dispatch tables with the 3.4 backend.
104 function Build_Inherit_Prims
107 Old_Tag_Node : Node_Id;
108 New_Tag_Node : Node_Id;
109 Num_Prims : Nat) return Node_Id;
110 -- Build code that inherits Num_Prims user-defined primitives from the
111 -- dispatch table of the parent type of tagged type Typ. It is used to
112 -- copy the dispatch table of the parent in the following cases:
113 -- a) case of derivations of CPP_Class types
114 -- b) tagged types whose dispatch table is not statically allocated
117 -- New_Tag.Prims_Ptr (1 .. Num_Prims) :=
118 -- Old_Tag.Prims_Ptr (1 .. Num_Prims);
120 function Build_Set_Predefined_Prim_Op_Address
124 Address_Node : Node_Id) return Node_Id;
125 -- Build code that saves the address of a virtual function in a given
126 -- Position of the portion of the dispatch table associated with the
127 -- predefined primitives of Tag. Called from Exp_Disp.Fill_DT_Entry
128 -- and Exp_Disp.Fill_Secondary_DT_Entry. It is used for:
129 -- 1) Filling the dispatch table of CPP_Class types.
130 -- 2) Late overriding (see Check_Dispatching_Operation).
132 -- Generates: Predefined_DT (Tag).D (Position) := Value
134 function Build_Set_Prim_Op_Address
139 Address_Node : Node_Id) return Node_Id;
140 -- Build code that saves the address of a virtual function in a given
141 -- Position of the dispatch table associated with the Tag. Called from
142 -- Exp_Disp.Fill_DT_Entry and Exp_Disp.Fill_Secondary_DT_Entry. Used for:
143 -- 1) Filling the dispatch table of CPP_Class types.
144 -- 2) Late overriding (see Check_Dispatching_Operation).
146 -- Generates: Tag.D (Position) := Value