1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 2006-2023, 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 3, 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 COPYING3. If not, go to --
19 -- http://www.gnu.org/licenses for a complete copy of the license. --
21 -- GNAT was originally developed by the GNAT team at New York University. --
22 -- Extensive contributions were provided by Ada Core Technologies Inc. --
24 ------------------------------------------------------------------------------
26 -- This package contains routines involved in the frontend expansion of
27 -- subprograms of package Ada.Tags
29 with Types
; use Types
;
30 with Uintp
; use Uintp
;
34 -- Note: In all the subprograms of this package formal 'Loc' is the source
35 -- location used in constructing the corresponding nodes.
37 procedure Build_Common_Dispatching_Select_Statements
40 -- Ada 2005 (AI-345): Build statements that are common to the expansion of
41 -- timed, asynchronous, and conditional select and append them to Stmts.
42 -- Typ is the tagged type used for dispatching calls.
44 function Build_Get_Access_Level
46 Tag_Node
: Node_Id
) return Node_Id
;
47 -- Build code that retrieves the accessibility level of the tagged type.
49 -- Generates: TSD (Tag).Access_Level
51 function Build_Get_Alignment
53 Tag_Node
: Node_Id
) return Node_Id
;
54 -- Build code that retrieves the alignment of the tagged type.
55 -- Generates: TSD (Tag).Alignment
57 procedure Build_Get_Predefined_Prim_Op_Address
60 Tag_Node
: in out Node_Id
;
61 New_Node
: out Node_Id
);
62 -- Given a pointer to a dispatch table (T) and a position in the DT, build
63 -- code that gets the address of the predefined virtual function stored in
64 -- it (used for dispatching calls). Tag_Node is relocated.
66 -- Generates: Predefined_DT (Tag).D (Position);
68 procedure Build_Get_Prim_Op_Address
72 Tag_Node
: in out Node_Id
;
73 New_Node
: out Node_Id
);
74 -- Build code that retrieves the address of the virtual function stored in
75 -- a given position of the dispatch table (used for dispatching calls).
76 -- Tag_Node is relocated.
78 -- Generates: To_Tag (Tag).D (Position);
80 function Build_Get_Transportable
82 Tag_Node
: Node_Id
) return Node_Id
;
83 -- Build code that retrieves the value of the Transportable flag for
86 -- Generates: TSD (Tag).Transportable;
88 function Build_Inherit_CPP_Prims
(Typ
: Entity_Id
) return List_Id
;
89 -- Build code that copies from Typ's parent the dispatch table slots of
90 -- inherited primitives and updates slots of overridden primitives. The
91 -- generated code handles primary and secondary dispatch tables of Typ.
93 function Build_Inherit_Predefined_Prims
95 Old_Tag_Node
: Node_Id
;
96 New_Tag_Node
: Node_Id
;
97 Num_Predef_Prims
: Nat
) return Node_Id
;
98 -- Build code that inherits the predefined primitives of the parent.
100 -- Generates: Predefined_DT (New_T).D (All_Predefined_Prims) :=
101 -- Predefined_DT (Old_T).D (All_Predefined_Prims);
103 -- Required to build non-library level dispatch tables. Also required
104 -- when compiling without static dispatch tables support.
106 function Build_Inherit_Prims
109 Old_Tag_Node
: Node_Id
;
110 New_Tag_Node
: Node_Id
;
111 Num_Prims
: Nat
) return Node_Id
;
112 -- Build code that inherits Num_Prims user-defined primitives from the
113 -- dispatch table of the parent type of tagged type Typ. It is used to
114 -- copy the dispatch table of the parent in the following cases:
115 -- a) case of derivations of CPP_Class types
116 -- b) tagged types whose dispatch table is not statically allocated
119 -- New_Tag.Prims_Ptr (1 .. Num_Prims) :=
120 -- Old_Tag.Prims_Ptr (1 .. Num_Prims);
122 function Build_Offset_To_Top
124 This_Node
: Node_Id
) return Node_Id
;
125 -- Build code that references the Offset_To_Top component of the primary
126 -- or secondary dispatch table associated with This_Node. This subprogram
127 -- provides a subset of the functionality provided by the function
128 -- Offset_To_Top of package Ada.Tags, and is only called by the frontend
129 -- when such routine is not available in a configurable runtime.
133 -- (Address!(Tag_Ptr!(This).all) - Offset_To_Top_Offset).all
135 function Build_Set_Predefined_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 portion of the dispatch table associated with the
142 -- predefined primitives of Tag. Called from Exp_Disp.Fill_DT_Entry
143 -- and Exp_Disp.Fill_Secondary_DT_Entry. It is used for:
144 -- 1) Filling the dispatch table of CPP_Class types.
145 -- 2) Late overriding (see Check_Dispatching_Operation).
147 -- Generates: Predefined_DT (Tag).D (Position) := Value
149 function Build_Set_Prim_Op_Address
154 Address_Node
: Node_Id
) return Node_Id
;
155 -- Build code that saves the address of a virtual function in a given
156 -- Position of the dispatch table associated with the Tag. Called from
157 -- Exp_Disp.Fill_DT_Entry and Exp_Disp.Fill_Secondary_DT_Entry. Used for:
158 -- 1) Filling the dispatch table of CPP_Class types.
159 -- 2) Late overriding (see Check_Dispatching_Operation).
161 -- Generates: Tag.D (Position) := Value
163 function Build_Set_Size_Function
166 Size_Func
: Entity_Id
) return Node_Id
;
167 -- Build code that saves in the TSD the address of the function
168 -- calculating _size of the object.
170 function Build_Set_Static_Offset_To_Top
173 Offset_Value
: Node_Id
) return Node_Id
;
174 -- Build code that initialize the Offset_To_Top component of the
175 -- secondary dispatch table referenced by Iface_Tag.
179 -- (Address!(Tag_Ptr!(This).all) - Offset_To_Top_Offset).all