git
/
gcc
mirror of git://gcc.gnu.org/git/gcc.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

exp_ch4.adb (Insert_Dereference_Action): Reimplemented. 

2012-05-15  Hristian Kirtchev  <kirtchev@adacore.com>

	* exp_ch4.adb (Insert_Dereference_Action): Reimplemented. The
	routine performs address and size adjustments for dereferences
	of heap-allocated controlled objects. This manipulation is needed
	in order to restore the original state of the memory at the time
	it was allocated by the finalization machinery.
	* rtsfind.ads: Add RE_Adjust_Controlled_Dereference to tables
	RE_Id and RE_Unit_Table.
	* sinfo.adb (Has_Dereference_Action): New routine.
	(Set_Has_Dereference_Action): New routine.
	* sinfo.ads: Add new semantic flag Has_Dereference_Action along
	its association in nodes.
	(Has_Dereference_Action): New routine and pragma Inline.
	(Set_Has_Dereference_Action): New routine and pragma Inline.
	* s-stposu.ads, s-stposu.adb (Adjust_Controlled_Dereference): New
	routine.

From-SVN: r187530
This commit is contained in:
Hristian Kirtchev 2012-05-15 12:09:44 +00:00 committed by Arnaud Charlet
parent 5b5b27adff
commit b0d7135584
7 changed files with 227 additions and 40 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
gcc/ada/ChangeLog
View File

@ -1,3 +1,21 @@
2012-05-15 Hristian Kirtchev <kirtchev@adacore.com>
* exp_ch4.adb (Insert_Dereference_Action): Reimplemented. The
routine performs address and size adjustments for dereferences
of heap-allocated controlled objects. This manipulation is needed
in order to restore the original state of the memory at the time
it was allocated by the finalization machinery.
* rtsfind.ads: Add RE_Adjust_Controlled_Dereference to tables
RE_Id and RE_Unit_Table.
* sinfo.adb (Has_Dereference_Action): New routine.
(Set_Has_Dereference_Action): New routine.
* sinfo.ads: Add new semantic flag Has_Dereference_Action along
its association in nodes.
(Has_Dereference_Action): New routine and pragma Inline.
(Set_Has_Dereference_Action): New routine and pragma Inline.
* s-stposu.ads, s-stposu.adb (Adjust_Controlled_Dereference): New
routine.
2012-05-15 Thomas Quinot <quinot@adacore.com>
* uintp.adb (Image_Uint): Use UI_Div_Rem to get quotient and

186
gcc/ada/exp_ch4.adb
View File

@ -10117,11 +10117,6 @@ package body Exp_Ch4 is
-------------------------------
procedure Insert_Dereference_Action (N : Node_Id) is
Loc : constant Source_Ptr := Sloc (N);
Typ : constant Entity_Id := Etype (N);
Pool : constant Entity_Id := Associated_Storage_Pool (Typ);
Pnod : constant Node_Id := Parent (N);
function Is_Checked_Storage_Pool (P : Entity_Id) return Boolean;
-- Return true if type of P is derived from Checked_Pool;
@ -10149,57 +10144,172 @@ package body Exp_Ch4 is
return False;
end Is_Checked_Storage_Pool;
-- Local variables
Typ : constant Entity_Id := Etype (N);
Desig : constant Entity_Id := Available_View (Designated_Type (Typ));
Loc : constant Source_Ptr := Sloc (N);
Pool : constant Entity_Id := Associated_Storage_Pool (Typ);
Pnod : constant Node_Id := Parent (N);
Addr : Entity_Id;
Alig : Entity_Id;
Deref : Node_Id;
Size : Entity_Id;
Stmt : Node_Id;
-- Start of processing for Insert_Dereference_Action
begin
pragma Assert (Nkind (Pnod) = N_Explicit_Dereference);
if not (Is_Checked_Storage_Pool (Pool)
and then Comes_From_Source (Original_Node (Pnod)))
then
-- Do not re-expand a dereference which has already been processed by
-- this routine.
if Has_Dereference_Action (Pnod) then
return;
-- Do not perform this type of expansion for internally-generated
-- dereferences.
elsif not Comes_From_Source (Original_Node (Pnod)) then
return;
-- A dereference action is only applicable to objects which have been
-- allocated on a checked pool.
elsif not Is_Checked_Storage_Pool (Pool) then
return;
end if;
-- Extract the address of the dereferenced object. Generate:
-- Addr : System.Address := <N>'Pool_Address;
Addr := Make_Temporary (Loc, 'P');
Insert_Action (N,
Make_Procedure_Call_Statement (Loc,
Name => New_Reference_To (
Find_Prim_Op (Etype (Pool), Name_Dereference), Loc),
Make_Object_Declaration (Loc,
Defining_Identifier => Addr,
Object_Definition =>
New_Reference_To (RTE (RE_Address), Loc),
Expression =>
Make_Attribute_Reference (Loc,
Prefix => Duplicate_Subexpr_Move_Checks (N),
Attribute_Name => Name_Pool_Address)));
Parameter_Associations => New_List (
-- Calculate the size of the dereferenced object. Generate:
-- Size : Storage_Count := <N>.all'Size / Storage_Unit;
-- Pool
Deref :=
Make_Explicit_Dereference (Loc,
Prefix => Duplicate_Subexpr_Move_Checks (N));
Set_Has_Dereference_Action (Deref);
New_Reference_To (Pool, Loc),
Size := Make_Temporary (Loc, 'S');
-- Storage_Address. We use the attribute Pool_Address, which uses
-- the pointer itself to find the address of the object, and which
-- handles unconstrained arrays properly by computing the address
-- of the template. i.e. the correct address of the corresponding
-- allocation.
Make_Attribute_Reference (Loc,
Prefix => Duplicate_Subexpr_Move_Checks (N),
Attribute_Name => Name_Pool_Address),
-- Size_In_Storage_Elements
Make_Op_Divide (Loc,
Left_Opnd =>
Insert_Action (N,
Make_Object_Declaration (Loc,
Defining_Identifier => Size,
Object_Definition =>
New_Reference_To (RTE (RE_Storage_Count), Loc),
Expression =>
Make_Op_Divide (Loc,
Left_Opnd =>
Make_Attribute_Reference (Loc,
Prefix =>
Make_Explicit_Dereference (Loc,
Duplicate_Subexpr_Move_Checks (N)),
Prefix => Deref,
Attribute_Name => Name_Size),
Right_Opnd =>
Make_Integer_Literal (Loc, System_Storage_Unit)),
Make_Integer_Literal (Loc, System_Storage_Unit))));
-- Alignment
-- Calculate the alignment of the dereferenced object. Generate:
-- Alig : constant Storage_Count := <N>.all'Alignment;
Make_Attribute_Reference (Loc,
Prefix =>
Make_Explicit_Dereference (Loc,
Duplicate_Subexpr_Move_Checks (N)),
Attribute_Name => Name_Alignment))));
Deref :=
Make_Explicit_Dereference (Loc,
Prefix => Duplicate_Subexpr_Move_Checks (N));
Set_Has_Dereference_Action (Deref);
Alig := Make_Temporary (Loc, 'A');
Insert_Action (N,
Make_Object_Declaration (Loc,
Defining_Identifier => Alig,
Object_Definition =>
New_Reference_To (RTE (RE_Storage_Count), Loc),
Expression =>
Make_Attribute_Reference (Loc,
Prefix => Deref,
Attribute_Name => Name_Alignment)));
-- A dereference of a controlled object requires special processing. The
-- finalization machinery requests additional space from the underlying
-- pool to allocate and hide two pointers. As a result, a checked pool
-- may mark the wrong memory as valid. Since checked pools do not have
-- knowledge of hidden pointers, we have to bring the two pointers back
-- in view in order to restore the original state of the object.
if Needs_Finalization (Desig) then
-- Adjust the address and size of the dereferenced object. Generate:
-- Adjust_Controlled_Dereference (Addr, Size, Alig);
Stmt :=
Make_Procedure_Call_Statement (Loc,
Name =>
New_Reference_To (RTE (RE_Adjust_Controlled_Dereference), Loc),
Parameter_Associations => New_List (
New_Reference_To (Addr, Loc),
New_Reference_To (Size, Loc),
New_Reference_To (Alig, Loc)));
-- Class-wide types complicate things because we cannot determine
-- statically whether the actual object is truly controlled. We must
-- generate a runtime check to detect this property. Generate:
--
-- if Needs_Finalization (<N>.all'Tag) then
-- <Stmt>;
-- end if;
if Is_Class_Wide_Type (Desig) then
Deref :=
Make_Explicit_Dereference (Loc,
Prefix => Duplicate_Subexpr_Move_Checks (N));
Set_Has_Dereference_Action (Deref);
Stmt :=
Make_If_Statement (Loc,
Condition =>
Make_Function_Call (Loc,
Name =>
New_Reference_To (RTE (RE_Needs_Finalization), Loc),
Parameter_Associations => New_List (
Make_Attribute_Reference (Loc,
Prefix => Deref,
Attribute_Name => Name_Tag))),
Then_Statements => New_List (Stmt));
end if;
Insert_Action (N, Stmt);
end if;
-- Generate:
-- Dereference (Pool, Addr, Size, Alig);
Insert_Action (N,
Make_Procedure_Call_Statement (Loc,
Name =>
New_Reference_To
(Find_Prim_Op (Etype (Pool), Name_Dereference), Loc),
Parameter_Associations => New_List (
New_Reference_To (Pool, Loc),
New_Reference_To (Addr, Loc),
New_Reference_To (Size, Loc),
New_Reference_To (Alig, Loc))));
-- Mark the explicit dereference as processed to avoid potential
-- infinite expansion.
Set_Has_Dereference_Action (Pnod);
exception
when RE_Not_Available =>

2
gcc/ada/rtsfind.ads
View File

@ -1401,6 +1401,7 @@ package Rtsfind is
RE_Root_Storage_Pool, -- System.Storage_Pools
RE_Root_Storage_Pool_Ptr, -- System.Storage_Pools
RE_Adjust_Controlled_Dereference, -- System.Storage_Pools.Subpools
RE_Allocate_Any_Controlled, -- System.Storage_Pools.Subpools
RE_Deallocate_Any_Controlled, -- System.Storage_Pools.Subpools
RE_Header_Size_With_Padding, -- System.Storage_Pools.Subpools
@ -2624,6 +2625,7 @@ package Rtsfind is
RE_Root_Storage_Pool => System_Storage_Pools,
RE_Root_Storage_Pool_Ptr => System_Storage_Pools,
RE_Adjust_Controlled_Dereference => System_Storage_Pools_Subpools,
RE_Allocate_Any_Controlled => System_Storage_Pools_Subpools,
RE_Deallocate_Any_Controlled => System_Storage_Pools_Subpools,
RE_Header_Size_With_Padding => System_Storage_Pools_Subpools,

20
gcc/ada/s-stposu.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2011, Free Software Foundation, Inc. --
-- Copyright (C) 2011-2012, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@ -56,6 +56,24 @@ package body System.Storage_Pools.Subpools is
procedure Detach (N : not null SP_Node_Ptr);
-- Unhook a subpool node from an arbitrary subpool list
procedure Adjust_Controlled_Dereference
(Addr : in out System.Address;
Storage_Size : in out System.Storage_Elements.Storage_Count;
Alignment : System.Storage_Elements.Storage_Count)
is
Header_And_Padding : constant Storage_Offset :=
Header_Size_With_Padding (Alignment);
begin
-- Expose the two hidden pointers by shifting the address from the
-- start of the object to the FM_Node equivalent of the pointers.
Addr := Addr - Header_And_Padding;
-- Update the size of the object to include the two pointers
Storage_Size := Storage_Size + Header_And_Padding;
end Adjust_Controlled_Dereference;
--------------
-- Allocate --
--------------

10
gcc/ada/s-stposu.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2011, Free Software Foundation, Inc. --
-- Copyright (C) 2011-2012, Free Software Foundation, Inc. --
-- --
-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow --
@ -249,6 +249,14 @@ private
-- This back pointer is used in subpool deallocation.
end record;
procedure Adjust_Controlled_Dereference
(Addr : in out System.Address;
Storage_Size : in out System.Storage_Elements.Storage_Count;
Alignment : System.Storage_Elements.Storage_Count);
-- Given the memory attributes of a heap-allocated object that is known to
-- be controlled, adjust the address and size of the object to include the
-- two hidden pointers inserted by the finalization machinery.
-- ??? Once Storage_Pools.Allocate_Any is removed, this should be renamed
-- to Allocate_Any.

16
gcc/ada/sinfo.adb
View File

@ -1427,6 +1427,14 @@ package body Sinfo is
return Flag15 (N);
end Has_Created_Identifier;
function Has_Dereference_Action
(N : Node_Id) return Boolean is
begin
pragma Assert (False
or else NT (N).Nkind = N_Explicit_Dereference);
return Flag13 (N);
end Has_Dereference_Action;
function Has_Dynamic_Length_Check
(N : Node_Id) return Boolean is
begin
@ -4515,6 +4523,14 @@ package body Sinfo is
Set_Flag15 (N, Val);
end Set_Has_Created_Identifier;
procedure Set_Has_Dereference_Action
(N : Node_Id; Val : Boolean := True) is
begin
pragma Assert (False
or else NT (N).Nkind = N_Explicit_Dereference);
Set_Flag13 (N, Val);
end Set_Has_Dereference_Action;
procedure Set_Has_Dynamic_Length_Check
(N : Node_Id; Val : Boolean := True) is
begin

15
gcc/ada/sinfo.ads
View File

@ -1111,6 +1111,12 @@ package Sinfo is
-- handler is deleted during optimization. For further details on why
-- this is required, see Exp_Ch11.Remove_Handler_Entries.
-- Has_Dereference_Action (Flag13-Sem)
-- This flag is present in N_Explicit_Dereference nodes. It is set to
-- indicate that the expansion has aready produced a call to primitive
-- Dereference of a System.Checked_Pools.Checked_Pool implementation.
-- Such dereference actions are produced for debugging purposes.
-- Has_Dynamic_Length_Check (Flag10-Sem)
-- This flag is present in all expression nodes. It is set to indicate
-- that one of the routines in unit Checks has generated a length check
@ -3192,6 +3198,7 @@ package Sinfo is
-- Prefix (Node3)
-- Actual_Designated_Subtype (Node4-Sem)
-- Atomic_Sync_Required (Flag14-Sem)
-- Has_Dereference_Action (Flag13-Sem)
-- plus fields for expression
-------------------------------
@ -8524,6 +8531,9 @@ package Sinfo is
function Has_Created_Identifier
(N : Node_Id) return Boolean; -- Flag15
function Has_Dereference_Action
(N : Node_Id) return Boolean; -- Flag13
function Has_Dynamic_Length_Check
(N : Node_Id) return Boolean; -- Flag10
@ -9508,6 +9518,9 @@ package Sinfo is
procedure Set_Has_Created_Identifier
(N : Node_Id; Val : Boolean := True); -- Flag15
procedure Set_Has_Dereference_Action
(N : Node_Id; Val : Boolean := True); -- Flag13
procedure Set_Has_Dynamic_Length_Check
(N : Node_Id; Val : Boolean := True); -- Flag10
@ -11947,6 +11960,7 @@ package Sinfo is
pragma Inline (Handled_Statement_Sequence);
pragma Inline (Handler_List_Entry);
pragma Inline (Has_Created_Identifier);
pragma Inline (Has_Dereference_Action);
pragma Inline (Has_Dynamic_Length_Check);
pragma Inline (Has_Dynamic_Range_Check);
pragma Inline (Has_Init_Expression);
@ -12272,6 +12286,7 @@ package Sinfo is
pragma Inline (Set_Handled_Statement_Sequence);
pragma Inline (Set_Handler_List_Entry);
pragma Inline (Set_Has_Created_Identifier);
pragma Inline (Set_Has_Dereference_Action);
pragma Inline (Set_Has_Dynamic_Length_Check);
pragma Inline (Set_Has_Init_Expression);
pragma Inline (Set_Has_Local_Raise);