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 procedure Build_Common_Dispatching_Select_Statements
39 -- Ada 2005 (AI-345): Generate statements that are common between timed,
40 -- asynchronous, and conditional select expansion.
42 function Build_CW_Membership
44 Obj_Tag_Node : Node_Id;
45 Typ_Tag_Node : Node_Id) return Node_Id;
46 -- Build code that returns true if Obj_Tag is in Typ_Tag'Class. Each DT
47 -- has a table of ancestors and its inheritance level (Idepth). Obj is in
48 -- Typ'Class if Typ'Tag is found in the table of ancestors referenced by
49 -- Obj'Tag. Knowing the level of inheritance of both types, this can be
50 -- computed in constant time by the formula:
52 -- TSD (Obj'tag).Tags_Table (TSD (Obj'tag).Idepth - TSD (Typ'tag).Idepth)
55 function Build_Get_Access_Level
57 Tag_Node : Node_Id) return Node_Id;
58 -- Build code that retrieves the accessibility level of the tagged type.
60 -- Generates: TSD (Tag).Access_Level
62 function Build_Get_Predefined_Prim_Op_Address
65 Position : Uint) return Node_Id;
66 -- Given a pointer to a dispatch table (T) and a position in the DT, build
67 -- code that gets the address of the predefined virtual function stored in
68 -- it (used for dispatching calls).
70 -- Generates: Predefined_DT (Tag).D (Position);
72 function Build_Get_Prim_Op_Address
76 Position : Uint) return Node_Id;
77 -- Build code that retrieves the address of the virtual function stored in
78 -- a given position of the dispatch table (used for dispatching calls).
80 -- Generates: To_Tag (Tag).D (Position);
82 function Build_Get_Transportable
84 Tag_Node : Node_Id) return Node_Id;
85 -- Build code that retrieves the value of the Transportable flag for
88 -- Generates: TSD (Tag).Transportable;
90 function Build_Inherit_Predefined_Prims
92 Old_Tag_Node : Node_Id;
93 New_Tag_Node : Node_Id) return Node_Id;
94 -- Build code that inherits the predefined primitives of the parent.
96 -- Generates: Predefined_DT (New_T).D (All_Predefined_Prims) :=
97 -- Predefined_DT (Old_T).D (All_Predefined_Prims);
99 -- Required to build the dispatch tables with the 3.4 backend.
101 function Build_Inherit_Prims
103 Old_Tag_Node : Node_Id;
104 New_Tag_Node : Node_Id;
105 Num_Prims : Nat) return Node_Id;
106 -- Build code that inherits Num_Prims user-defined primitives from the
107 -- dispatch table of the parent type. It is used to copy the dispatch
108 -- table of the parent in case of derivations of CPP_Class types.
111 -- New_Tag.Prims_Ptr (1 .. Num_Prims) :=
112 -- Old_Tag.Prims_Ptr (1 .. Num_Prims);
114 function Build_Set_Predefined_Prim_Op_Address
118 Address_Node : Node_Id) return Node_Id;
119 -- Build code that saves the address of a virtual function in a given
120 -- Position of the portion of the dispatch table associated with the
121 -- predefined primitives of Tag. Called from Exp_Disp.Fill_DT_Entry
122 -- and Exp_Disp.Fill_Secondary_DT_Entry. It is used for:
123 -- 1) Filling the dispatch table of CPP_Class types.
124 -- 2) Late overriding (see Check_Dispatching_Operation).
126 -- Generates: Predefined_DT (Tag).D (Position) := Value
128 function Build_Set_Prim_Op_Address
133 Address_Node : Node_Id) return Node_Id;
134 -- Build code that saves the address of a virtual function in a given
135 -- Position of the dispatch table associated with the Tag. Called from
136 -- Exp_Disp.Fill_DT_Entry and Exp_Disp.Fill_Secondary_DT_Entry. Used for:
137 -- 1) Filling the dispatch table of CPP_Class types.
138 -- 2) Late overriding (see Check_Dispatching_Operation).
140 -- Generates: Tag.D (Position) := Value