1------------------------------------------------------------------------------
2--                                                                          --
3--                         GNAT COMPILER COMPONENTS                         --
4--                                                                          --
5--                             E X P _ A T A G                              --
6--                                                                          --
7--                                 S p e c                                  --
8--                                                                          --
9--          Copyright (C) 2006-2020, Free Software Foundation, Inc.         --
10--                                                                          --
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.          --
20--                                                                          --
21-- GNAT was originally developed  by the GNAT team at  New York University. --
22-- Extensive contributions were provided by Ada Core Technologies Inc.      --
23--                                                                          --
24------------------------------------------------------------------------------
25
26--  This package contains routines involved in the frontend expansion of
27--  subprograms of package Ada.Tags
28
29with Types; use Types;
30with Uintp; use Uintp;
31
32package Exp_Atag is
33
34   --  Note: In all the subprograms of this package formal 'Loc' is the source
35   --  location used in constructing the corresponding nodes.
36
37   procedure Build_Common_Dispatching_Select_Statements
38     (Typ   : Entity_Id;
39      Stmts : List_Id);
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.
43
44   function Build_Get_Access_Level
45     (Loc      : Source_Ptr;
46      Tag_Node : Node_Id) return Node_Id;
47   --  Build code that retrieves the accessibility level of the tagged type.
48   --
49   --  Generates: TSD (Tag).Access_Level
50
51   function Build_Get_Alignment
52     (Loc      : Source_Ptr;
53      Tag_Node : Node_Id) return Node_Id;
54   --  Build code that retrieves the alignment of the tagged type.
55   --  Generates: TSD (Tag).Alignment
56
57   procedure Build_Get_Predefined_Prim_Op_Address
58     (Loc      : Source_Ptr;
59      Position : Uint;
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.
65   --
66   --  Generates: Predefined_DT (Tag).D (Position);
67
68   procedure Build_Get_Prim_Op_Address
69     (Loc      : Source_Ptr;
70      Typ      : Entity_Id;
71      Position : Uint;
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.
77   --
78   --  Generates: To_Tag (Tag).D (Position);
79
80   function Build_Get_Transportable
81     (Loc      : Source_Ptr;
82      Tag_Node : Node_Id) return Node_Id;
83   --  Build code that retrieves the value of the Transportable flag for
84   --  the given Tag.
85   --
86   --  Generates: TSD (Tag).Transportable;
87
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.
92
93   function Build_Inherit_Predefined_Prims
94     (Loc              : Source_Ptr;
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.
99   --
100   --  Generates: Predefined_DT (New_T).D (All_Predefined_Prims) :=
101   --               Predefined_DT (Old_T).D (All_Predefined_Prims);
102   --
103   --  Required to build non-library level dispatch tables. Also required
104   --  when compiling without static dispatch tables support.
105
106   function Build_Inherit_Prims
107     (Loc          : Source_Ptr;
108      Typ          : Entity_Id;
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
117   --
118   --  Generates:
119   --    New_Tag.Prims_Ptr (1 .. Num_Prims) :=
120   --      Old_Tag.Prims_Ptr (1 .. Num_Prims);
121
122   function Build_Offset_To_Top
123     (Loc       : Source_Ptr;
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.
130   --
131   --  Generates:
132   --    Offset_To_Top_Ptr
133   --      (Address!(Tag_Ptr!(This).all) - Offset_To_Top_Offset).all
134
135   function Build_Set_Predefined_Prim_Op_Address
136     (Loc          : Source_Ptr;
137      Tag_Node     : Node_Id;
138      Position     : Uint;
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).
146   --
147   --  Generates: Predefined_DT (Tag).D (Position) := Value
148
149   function Build_Set_Prim_Op_Address
150     (Loc          : Source_Ptr;
151      Typ          : Entity_Id;
152      Tag_Node     : Node_Id;
153      Position     : Uint;
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).
160   --
161   --  Generates: Tag.D (Position) := Value
162
163   function Build_Set_Size_Function
164     (Loc       : Source_Ptr;
165      Tag_Node  : Node_Id;
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.
169
170   function Build_Set_Static_Offset_To_Top
171     (Loc          : Source_Ptr;
172      Iface_Tag    : Node_Id;
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.
176   --
177   --  Generates:
178   --    Offset_To_Top_Ptr
179   --      (Address!(Tag_Ptr!(This).all) - Offset_To_Top_Offset).all
180   --     := Offset_Value
181
182end Exp_Atag;
183