OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

[Ada] Buffer reading overflow in dispatch table initialization 

For tagged types not defined at library level that derive from library
level tagged types the compiler may generate code to initialize their
dispatch table of predefined primitives copying from the parent type
data stored in memory after the dispatch table of the parent; that is,
at runtime the initialization of dispatch tables overflows reading the
parent dispatch table.

This problem does not affect the execution of the program since the
target dispatch table always has enough space to store the extra data,
and after such copy the compiler generates code to complete the
initialization of the dispatch table.

The following test must compile and execute without errors.

package pkg_a is
   type Root is tagged null record;
end pkg_a;

with pkg_a;
procedure main is
   type Derived is new pkg_a.Root with null record;  -- Test
begin
   null;
end main;

Command: gnatmake -q main -fsanitize=address; ./main

2019-08-19  Javier Miranda  <miranda@adacore.com>

gcc/ada/

	PR ada/65696
	* exp_atag.ads, exp_atag.adb (Build_Inherit_Predefined_Prims):
	Adding formal to specify how many predefined primitives are
	inherited from the parent type.
	* exp_disp.adb (Number_Of_Predefined_Prims): New subprogram.
	(Make_Secondary_DT): Compute the number of predefined primitives
	of all tagged types (including tagged types not defined at
	library level).  Previously we unconditionally relied on the
	Max_Predef_Prims constant value when building the dispatch
	tables of tagged types not defined at library level (thus
	consuming more memory for their dispatch tables than required).
	(Make_DT): Compute the number of predefined primitives that must
	be inherited from their parent type when building the dispatch
	tables of tagged types not defined at library level. Previously
	we unconditionally relied on the Max_Predef_Prims constant value
	when building the dispatch tables of tagged types not defined at
	library level (thus copying more data than required from the
	parent type).

From-SVN: r274654
This commit is contained in:
Javier Miranda 2019-08-19 08:36:39 +00:00 committed by Pierre-Marie de Rodat
parent d403cfad2f
commit bd5ed03ae9
4 changed files with 142 additions and 126 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
gcc/ada/ChangeLog
View File

@ -1,3 +1,24 @@
2019-08-19 Javier Miranda <miranda@adacore.com>
PR ada/65696
* exp_atag.ads, exp_atag.adb (Build_Inherit_Predefined_Prims):
Adding formal to specify how many predefined primitives are
inherited from the parent type.
* exp_disp.adb (Number_Of_Predefined_Prims): New subprogram.
(Make_Secondary_DT): Compute the number of predefined primitives
of all tagged types (including tagged types not defined at
library level). Previously we unconditionally relied on the
Max_Predef_Prims constant value when building the dispatch
tables of tagged types not defined at library level (thus
consuming more memory for their dispatch tables than required).
(Make_DT): Compute the number of predefined primitives that must
be inherited from their parent type when building the dispatch
tables of tagged types not defined at library level. Previously
we unconditionally relied on the Max_Predef_Prims constant value
when building the dispatch tables of tagged types not defined at
library level (thus copying more data than required from the
parent type).
2019-08-19 Bob Duff <duff@adacore.com>
* sem_ch13.adb (Record_Hole_Check): Procedure to check for holes

11
gcc/ada/exp_atag.adb
View File

@ -742,9 +742,10 @@ package body Exp_Atag is
------------------------------------
function Build_Inherit_Predefined_Prims
(Loc : Source_Ptr;
Old_Tag_Node : Node_Id;
New_Tag_Node : Node_Id) return Node_Id
(Loc : Source_Ptr;
Old_Tag_Node : Node_Id;
New_Tag_Node : Node_Id;
Num_Predef_Prims : Int) return Node_Id
is
begin
return
@ -759,7 +760,7 @@ package body Exp_Atag is
New_Tag_Node)))),
Discrete_Range => Make_Range (Loc,
Make_Integer_Literal (Loc, Uint_1),
New_Occurrence_Of (RTE (RE_Max_Predef_Prims), Loc))),
Make_Integer_Literal (Loc, Num_Predef_Prims))),
Expression =>
Make_Slice (Loc,
@ -772,7 +773,7 @@ package body Exp_Atag is
Discrete_Range =>
Make_Range (Loc,
Make_Integer_Literal (Loc, 1),
New_Occurrence_Of (RTE (RE_Max_Predef_Prims), Loc))));
Make_Integer_Literal (Loc, Num_Predef_Prims))));
end Build_Inherit_Predefined_Prims;
-------------------------

7
gcc/ada/exp_atag.ads
View File

@ -109,9 +109,10 @@ package Exp_Atag is
-- generated code handles primary and secondary dispatch tables of Typ.
function Build_Inherit_Predefined_Prims
(Loc : Source_Ptr;
Old_Tag_Node : Node_Id;
New_Tag_Node : Node_Id) return Node_Id;
(Loc : Source_Ptr;
Old_Tag_Node : Node_Id;
New_Tag_Node : Node_Id;
Num_Predef_Prims : Int) return Node_Id;
-- Build code that inherits the predefined primitives of the parent.
--
-- Generates: Predefined_DT (New_T).D (All_Predefined_Prims) :=

229
gcc/ada/exp_disp.adb
View File

@ -3817,6 +3817,9 @@ package body Exp_Disp is
-- 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 --
------------------------------
@ -3970,12 +3973,10 @@ package body Exp_Disp is
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;
@ -4022,38 +4023,12 @@ package body Exp_Disp is
-- 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;
@ -4525,6 +4500,44 @@ package body Exp_Disp is
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;
@ -4584,7 +4597,6 @@ package body Exp_Disp is
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;
@ -5924,112 +5936,85 @@ package body Exp_Disp is
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
@ -6301,7 +6286,9 @@ package body Exp_Disp is
(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,
@ -6390,7 +6377,10 @@ package body Exp_Disp is
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,
@ -6436,7 +6426,10 @@ package body Exp_Disp is
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,