-- this secondary dispatch table by Make_Tags when its unique external
-- name was generated.
+ function Number_Of_Predefined_Prims (Typ : Entity_Id) return Nat;
+ -- Returns the number of predefined primitives of Typ
+
------------------------------
-- Check_Premature_Freezing --
------------------------------
DT_Constr_List : List_Id;
DT_Aggr_List : List_Id;
Empty_DT : Boolean := False;
- Nb_Predef_Prims : Nat := 0;
Nb_Prim : Nat;
New_Node : Node_Id;
OSD : Entity_Id;
OSD_Aggr_List : List_Id;
- Pos : Nat;
Prim : Entity_Id;
Prim_Elmt : Elmt_Id;
Prim_Ops_Aggr_List : List_Id;
-- predef-prim-op-thunk-n'address);
-- for Predef_Prims'Alignment use Address'Alignment
- -- Stage 1: Calculate the number of predefined primitives
-
- if not Building_Static_DT (Typ) then
- Nb_Predef_Prims := Max_Predef_Prims;
- else
- Prim_Elmt := First_Elmt (Primitive_Operations (Typ));
- while Present (Prim_Elmt) loop
- Prim := Node (Prim_Elmt);
-
- if Is_Predefined_Dispatching_Operation (Prim)
- and then not Is_Abstract_Subprogram (Prim)
- then
- Pos := UI_To_Int (DT_Position (Prim));
-
- if Pos > Nb_Predef_Prims then
- Nb_Predef_Prims := Pos;
- end if;
- end if;
-
- Next_Elmt (Prim_Elmt);
- end loop;
- end if;
-
- if Generate_SCIL then
- Nb_Predef_Prims := 0;
- end if;
-
- -- Stage 2: Create the thunks associated with the predefined
- -- primitives and save their entity to fill the aggregate.
+ -- Create the thunks associated with the predefined primitives and
+ -- save their entity to fill the aggregate.
declare
- Prim_Table : array (Nat range 1 .. Nb_Predef_Prims) of Entity_Id;
+ Nb_P_Prims : constant Nat := Number_Of_Predefined_Prims (Typ);
+ Prim_Table : array (Nat range 1 .. Nb_P_Prims) of Entity_Id;
Decl : Node_Id;
Thunk_Id : Entity_Id;
Thunk_Code : Node_Id;
Append_Elmt (Iface_DT, DT_Decl);
end Make_Secondary_DT;
+ --------------------------------
+ -- Number_Of_Predefined_Prims --
+ --------------------------------
+
+ function Number_Of_Predefined_Prims (Typ : Entity_Id) return Nat is
+ Nb_Predef_Prims : Nat := 0;
+
+ begin
+ if not Generate_SCIL then
+ declare
+ Prim : Entity_Id;
+ Prim_Elmt : Elmt_Id;
+ Pos : Nat;
+
+ begin
+ Prim_Elmt := First_Elmt (Primitive_Operations (Typ));
+ while Present (Prim_Elmt) loop
+ Prim := Node (Prim_Elmt);
+
+ if Is_Predefined_Dispatching_Operation (Prim)
+ and then not Is_Abstract_Subprogram (Prim)
+ then
+ Pos := UI_To_Int (DT_Position (Prim));
+
+ if Pos > Nb_Predef_Prims then
+ Nb_Predef_Prims := Pos;
+ end if;
+ end if;
+
+ Next_Elmt (Prim_Elmt);
+ end loop;
+ end;
+ end if;
+
+ pragma Assert (Nb_Predef_Prims <= Max_Predef_Prims);
+ return Nb_Predef_Prims;
+ end Number_Of_Predefined_Prims;
+
-- Local variables
Elab_Code : constant List_Id := New_List;
I_Depth : Nat := 0;
Iface_Table_Node : Node_Id;
Name_ITable : Name_Id;
- Nb_Predef_Prims : Nat := 0;
Nb_Prim : Nat := 0;
New_Node : Node_Id;
Num_Ifaces : Nat := 0;
else
declare
- Pos : Nat;
+ Nb_P_Prims : constant Nat := Number_Of_Predefined_Prims (Typ);
+ Prim_Table : array (Nat range 1 .. Nb_P_Prims) of Entity_Id;
+ Decl : Node_Id;
+ E : Entity_Id;
begin
- if not Building_Static_DT (Typ) then
- Nb_Predef_Prims := Max_Predef_Prims;
+ Prim_Ops_Aggr_List := New_List;
+ Prim_Table := (others => Empty);
- else
- Prim_Elmt := First_Elmt (Primitive_Operations (Typ));
+ if Building_Static_DT (Typ) then
+ Prim_Elmt := First_Elmt (Primitive_Operations (Typ));
while Present (Prim_Elmt) loop
Prim := Node (Prim_Elmt);
if Is_Predefined_Dispatching_Operation (Prim)
and then not Is_Abstract_Subprogram (Prim)
+ and then not Is_Eliminated (Prim)
+ and then not Generate_SCIL
+ and then not Present (Prim_Table
+ (UI_To_Int (DT_Position (Prim))))
then
- Pos := UI_To_Int (DT_Position (Prim));
-
- if Pos > Nb_Predef_Prims then
- Nb_Predef_Prims := Pos;
- end if;
+ E := Ultimate_Alias (Prim);
+ pragma Assert (not Is_Abstract_Subprogram (E));
+ Prim_Table (UI_To_Int (DT_Position (Prim))) := E;
end if;
Next_Elmt (Prim_Elmt);
end loop;
end if;
- declare
- Prim_Table : array
- (Nat range 1 .. Nb_Predef_Prims) of Entity_Id;
- Decl : Node_Id;
- E : Entity_Id;
-
- begin
- Prim_Ops_Aggr_List := New_List;
-
- Prim_Table := (others => Empty);
-
- if Building_Static_DT (Typ) then
- Prim_Elmt := First_Elmt (Primitive_Operations (Typ));
- while Present (Prim_Elmt) loop
- Prim := Node (Prim_Elmt);
-
- if Is_Predefined_Dispatching_Operation (Prim)
- and then not Is_Abstract_Subprogram (Prim)
- and then not Is_Eliminated (Prim)
- and then not Present (Prim_Table
- (UI_To_Int (DT_Position (Prim))))
- then
- E := Ultimate_Alias (Prim);
- pragma Assert (not Is_Abstract_Subprogram (E));
- Prim_Table (UI_To_Int (DT_Position (Prim))) := E;
- end if;
-
- Next_Elmt (Prim_Elmt);
- end loop;
+ for J in Prim_Table'Range loop
+ if Present (Prim_Table (J)) then
+ New_Node :=
+ Unchecked_Convert_To (RTE (RE_Prim_Ptr),
+ Make_Attribute_Reference (Loc,
+ Prefix =>
+ New_Occurrence_Of (Prim_Table (J), Loc),
+ Attribute_Name => Name_Unrestricted_Access));
+ else
+ New_Node := Make_Null (Loc);
end if;
- for J in Prim_Table'Range loop
- if Present (Prim_Table (J)) then
- New_Node :=
- Unchecked_Convert_To (RTE (RE_Prim_Ptr),
- Make_Attribute_Reference (Loc,
- Prefix =>
- New_Occurrence_Of (Prim_Table (J), Loc),
- Attribute_Name => Name_Unrestricted_Access));
- else
- New_Node := Make_Null (Loc);
- end if;
-
- Append_To (Prim_Ops_Aggr_List, New_Node);
- end loop;
+ Append_To (Prim_Ops_Aggr_List, New_Node);
+ end loop;
- New_Node :=
- Make_Aggregate (Loc,
- Expressions => Prim_Ops_Aggr_List);
+ New_Node :=
+ Make_Aggregate (Loc,
+ Expressions => Prim_Ops_Aggr_List);
- Decl :=
- Make_Subtype_Declaration (Loc,
- Defining_Identifier => Make_Temporary (Loc, 'S'),
- Subtype_Indication =>
- New_Occurrence_Of (RTE (RE_Address_Array), Loc));
+ Decl :=
+ Make_Subtype_Declaration (Loc,
+ Defining_Identifier => Make_Temporary (Loc, 'S'),
+ Subtype_Indication =>
+ New_Occurrence_Of (RTE (RE_Address_Array), Loc));
- Append_To (Result, Decl);
+ Append_To (Result, Decl);
- Append_To (Result,
- Make_Object_Declaration (Loc,
- Defining_Identifier => Predef_Prims,
- Aliased_Present => True,
- Constant_Present => Building_Static_DT (Typ),
- Object_Definition =>
- New_Occurrence_Of (Defining_Identifier (Decl), Loc),
- Expression => New_Node));
+ Append_To (Result,
+ Make_Object_Declaration (Loc,
+ Defining_Identifier => Predef_Prims,
+ Aliased_Present => True,
+ Constant_Present => Building_Static_DT (Typ),
+ Object_Definition =>
+ New_Occurrence_Of (Defining_Identifier (Decl), Loc),
+ Expression => New_Node));
- -- Remember aggregates initializing dispatch tables
+ -- Remember aggregates initializing dispatch tables
- Append_Elmt (New_Node, DT_Aggr);
+ Append_Elmt (New_Node, DT_Aggr);
- Append_To (Result,
- Make_Attribute_Definition_Clause (Loc,
- Name => New_Occurrence_Of (Predef_Prims, Loc),
- Chars => Name_Alignment,
- Expression =>
- Make_Attribute_Reference (Loc,
- Prefix =>
- New_Occurrence_Of (RTE (RE_Integer_Address), Loc),
- Attribute_Name => Name_Alignment)));
- end;
+ Append_To (Result,
+ Make_Attribute_Definition_Clause (Loc,
+ Name => New_Occurrence_Of (Predef_Prims, Loc),
+ Chars => Name_Alignment,
+ Expression =>
+ Make_Attribute_Reference (Loc,
+ Prefix =>
+ New_Occurrence_Of (RTE (RE_Integer_Address), Loc),
+ Attribute_Name => Name_Alignment)));
end;
-- Stage 1: Initialize the discriminant and the record components
(Node
(Next_Elmt
(First_Elmt
- (Access_Disp_Table (Typ)))), Loc)));
+ (Access_Disp_Table (Typ)))), Loc),
+ Num_Predef_Prims =>
+ Number_Of_Predefined_Prims (Parent_Typ)));
if Nb_Prims /= 0 then
Append_To (Elab_Code,
Unchecked_Convert_To (RTE (RE_Tag),
New_Occurrence_Of
(Node (Next_Elmt (Sec_DT_Typ)),
- Loc))));
+ Loc)),
+ Num_Predef_Prims =>
+ Number_Of_Predefined_Prims
+ (Parent_Typ)));
if Num_Prims /= 0 then
Append_To (Elab_Code,
Unchecked_Convert_To (RTE (RE_Tag),
New_Occurrence_Of
(Node (Next_Elmt (Sec_DT_Typ)),
- Loc))));
+ Loc)),
+ Num_Predef_Prims =>
+ Number_Of_Predefined_Prims
+ (Parent_Typ)));
if Num_Prims /= 0 then
Append_To (Elab_Code,