mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-04-15 18:50:45 +08:00
Code Issues Packages Projects Releases Wiki Activity

[multiple changes]

Browse Source 
2012-04-25  Gary Dismukes  <dismukes@adacore.com>

	* exp_ch9.adb: Add comments on the usage of the
	lock-free data structures.

2012-04-25  Vincent Pucci  <pucci@adacore.com>

	* exp_intr.adb (Expand_Shift): Convert the left
	operand and the operator when the type of the call differs from
	the type of the operator.

2012-04-25  Geert Bosch  <bosch@adacore.com>

	* stand.ads: Minor comment fix.

2012-04-25  Hristian Kirtchev  <kirtchev@adacore.com>

	* sem_ch4.adb (Analyze_Slice): Handle the case where the prefix
	is a string literal. Retrieve the first index from the base type
	when slicing a string literal.
	* sem_ch12.adb (Check_Private_View): Move the initialization
	of the type inside the loop to reflect the changing index.
	* sem_eval.adb (Eval_Relational_Op): Retrieve the first index
	from the base type when dealing with a string literal.
	* sem_res.adb (Resolve_Slice): Retrieve the first index from
	the base type when slicing a string literal.
	* sem_util.adb (Is_Internally_Generated_Renaming): New routine.
	(Is_Object_Reference): String literals may act
	as object references only when they are renamed internally.
	(Proper_First_Index): New routine.
	* sem_util.ads (Proper_First_Index): New routine.

From-SVN: r186829
This commit is contained in:
Arnaud Charlet 2012-04-25 17:17:25 +02:00
parent 39ad16657c
commit 03ad478dc5
10 changed files with 141 additions and 27 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

32
gcc/ada/ChangeLog
View File

@ -1,3 +1,35 @@
2012-04-25 Gary Dismukes <dismukes@adacore.com>
* exp_ch9.adb: Add comments on the usage of the
lock-free data structures.
2012-04-25 Vincent Pucci <pucci@adacore.com>
* exp_intr.adb (Expand_Shift): Convert the left
operand and the operator when the type of the call differs from
the type of the operator.
2012-04-25 Geert Bosch <bosch@adacore.com>
* stand.ads: Minor comment fix.
2012-04-25 Hristian Kirtchev <kirtchev@adacore.com>
* sem_ch4.adb (Analyze_Slice): Handle the case where the prefix
is a string literal. Retrieve the first index from the base type
when slicing a string literal.
* sem_ch12.adb (Check_Private_View): Move the initialization
of the type inside the loop to reflect the changing index.
* sem_eval.adb (Eval_Relational_Op): Retrieve the first index
from the base type when dealing with a string literal.
* sem_res.adb (Resolve_Slice): Retrieve the first index from
the base type when slicing a string literal.
* sem_util.adb (Is_Internally_Generated_Renaming): New routine.
(Is_Object_Reference): String literals may act
as object references only when they are renamed internally.
(Proper_First_Index): New routine.
* sem_util.ads (Proper_First_Index): New routine.
2012-04-25 Robert Dewar <dewar@adacore.com>
* sem_ch3.adb, csinfo.adb, lib-writ.adb, sem_ch12.adb,

22
gcc/ada/exp_ch9.adb
View File

@ -81,16 +81,24 @@ package body Exp_Ch9 is
-- Lock Free Data Structure --
------------------------------
-- A lock-free subprogram is a protected routine which references a unique
-- protected scalar component and does not contain statements that cause
-- side effects. Due to this restricted behavior, all references to shared
-- data from within the subprogram can be synchronized through the use of
-- atomic operations rather than relying on locks.
type Lock_Free_Subprogram is record
Sub_Body : Node_Id;
Comp_Id : Entity_Id;
end record;
-- This data structure and its fields must be documented, ALL global
-- data structures must be documented. We never rely on guessing what
-- things mean from their names.
-- Reference to the body of a protected subprogram which meets the lock-
-- free requirements.
-- The following table establishes a relation between a subprogram body and
-- an unique protected component referenced in this body.
Comp_Id : Entity_Id;
-- Reference to the scalar component referenced from within Sub_Body
end record;
-- This table establishes a relation between a protected subprogram body
-- and a unique component it references. The table is used when building
-- the lock-free versions of a protected subprogram body.
package Lock_Free_Subprogram_Table is new Table.Table (
Table_Component_Type => Lock_Free_Subprogram,

36
gcc/ada/exp_intr.adb
View File

@ -650,20 +650,20 @@ package body Exp_Intr is
-- and Resolve. Such shift operator nodes will not be seen by Expand_Shift.
procedure Expand_Shift (N : Node_Id; E : Entity_Id; K : Node_Kind) is
Loc : constant Source_Ptr := Sloc (N);
Typ : constant Entity_Id := Etype (N);
Entyp : constant Entity_Id := Etype (E);
Left : constant Node_Id := First_Actual (N);
Loc : constant Source_Ptr := Sloc (N);
Right : constant Node_Id := Next_Actual (Left);
Ltyp : constant Node_Id := Etype (Left);
Rtyp : constant Node_Id := Etype (Right);
Typ : constant Entity_Id := Etype (N);
Snode : Node_Id;
begin
Snode := New_Node (K, Loc);
Set_Left_Opnd (Snode, Relocate_Node (Left));
Set_Right_Opnd (Snode, Relocate_Node (Right));
Set_Chars (Snode, Chars (E));
Set_Etype (Snode, Base_Type (Typ));
Set_Etype (Snode, Base_Type (Entyp));
Set_Entity (Snode, E);
if Compile_Time_Known_Value (Type_High_Bound (Rtyp))
@ -672,12 +672,30 @@ package body Exp_Intr is
Set_Shift_Count_OK (Snode, True);
end if;
-- Do the rewrite. Note that we don't call Analyze and Resolve on
-- this node, because it already got analyzed and resolved when
-- it was a function call!
if Typ = Entyp then
Rewrite (N, Snode);
Set_Analyzed (N);
-- Note that we don't call Analyze and Resolve on this node, because
-- it already got analyzed and resolved when it was a function call.
Set_Left_Opnd (Snode, Relocate_Node (Left));
Rewrite (N, Snode);
Set_Analyzed (N);
else
-- If the context type is not the type of the operator, it is an
-- inherited operator for a derived type. Wrap the node in a
-- conversion so that it is type-consistent for possible further
-- expansion (e.g. within a lock-free protected type).
Set_Left_Opnd (Snode,
Unchecked_Convert_To (Base_Type (Entyp), Relocate_Node (Left)));
Rewrite (N, Unchecked_Convert_To (Typ, Snode));
-- Analyze and resolve result formed by conversion to target type
Analyze_And_Resolve (N, Typ);
end if;
end Expand_Shift;
------------------------

3
gcc/ada/sem_ch12.adb
View File

@ -6128,8 +6128,9 @@ package body Sem_Ch12 is
begin
Indx := First_Index (T);
Typ := Base_Type (Etype (Indx));
while Present (Indx) loop
Typ := Base_Type (Etype (Indx));
if Is_Private_Type (Typ)
and then Present (Full_View (Typ))
then

4
gcc/ada/sem_ch4.adb
View File

@ -4514,9 +4514,9 @@ package body Sem_Ch4 is
("type is not one-dimensional array in slice prefix", N);
elsif not
Has_Compatible_Type (D, Etype (First_Index (Array_Type)))
Has_Compatible_Type (D, Etype (Proper_First_Index (Array_Type)))
then
Wrong_Type (D, Etype (First_Index (Array_Type)));
Wrong_Type (D, Etype (Proper_First_Index (Array_Type)));
else
Set_Etype (N, Array_Type);

2
gcc/ada/sem_eval.adb
View File

@ -2747,7 +2747,7 @@ package body Sem_Eval is
-- General case
T := Etype (First_Index (Etype (Op)));
T := Etype (Proper_First_Index (Etype (Op)));
-- The simple case, both bounds are known at compile time

2
gcc/ada/sem_res.adb
View File

@ -9003,7 +9003,7 @@ package body Sem_Res is
-- necessary. Else resolve the bounds, and apply needed checks.
if not Is_Entity_Name (Drange) then
Index := First_Index (Array_Type);
Index := Proper_First_Index (Array_Type);
Resolve (Drange, Base_Type (Etype (Index)));
if Nkind (Drange) = N_Range then

52
gcc/ada/sem_util.adb
View File

@ -3573,7 +3573,6 @@ package body Sem_Util is
if Present (C)
and then Restriction_Check_Required (SPARK)
then
declare
Enclosing_Subp : constant Node_Id := Enclosing_Subprogram (Def_Id);
Enclosing_Pack : constant Node_Id := Enclosing_Package (Def_Id);
@ -7587,6 +7586,34 @@ package body Sem_Util is
-------------------------
function Is_Object_Reference (N : Node_Id) return Boolean is
function Is_Internally_Generated_Renaming (N : Node_Id) return Boolean;
-- Determine whether N is the name of an internally-generated renaming
--------------------------------------
-- Is_Internally_Generated_Renaming --
--------------------------------------
function Is_Internally_Generated_Renaming (N : Node_Id) return Boolean is
P : Node_Id := N;
begin
while Present (P) loop
if Nkind (P) = N_Object_Renaming_Declaration then
return not Comes_From_Source (P);
elsif Is_List_Member (P) then
return False;
end if;
P := Parent (P);
end loop;
return False;
end Is_Internally_Generated_Renaming;
-- Start of processing for Is_Object_Reference
begin
if Is_Entity_Name (N) then
return Present (Entity (N)) and then Is_Object (Entity (N));
@ -7633,6 +7660,14 @@ package body Sem_Util is
when N_Unchecked_Type_Conversion =>
return True;
-- Allow string literals to act as objects as long as they appear
-- in internally-generated renamings. The expansion of iterators
-- may generate such renamings when the range involves a string
-- literal.
when N_String_Literal =>
return Is_Internally_Generated_Renaming (Parent (N));
when others =>
return False;
end case;
@ -11619,6 +11654,21 @@ package body Sem_Util is
Set_Sloc (Endl, Loc);
end Process_End_Label;
------------------------
-- Proper_First_Index --
------------------------
function Proper_First_Index (Array_Typ : Entity_Id) return Entity_Id is
Typ : Entity_Id := Array_Typ;
begin
if Ekind (Typ) = E_String_Literal_Subtype then
Typ := Base_Type (Typ);
end if;
return First_Index (Typ);
end Proper_First_Index;
------------------------------------
-- References_Generic_Formal_Type --
------------------------------------

5
gcc/ada/sem_util.ads
View File

@ -1284,6 +1284,11 @@ package Sem_Util is
-- parameter Ent gives the entity to which the End_Label refers,
-- and to which cross-references are to be generated.
function Proper_First_Index (Array_Typ : Entity_Id) return Entity_Id;
-- Return the First_Index attribute of an arbitrary array type unless it
-- is a string literal subtype in which case return the First_Index of the
-- base type.
function References_Generic_Formal_Type (N : Node_Id) return Boolean;
-- Returns True if the expression Expr contains any references to a
-- generic type. This can only happen within a generic template.

10
gcc/ada/stand.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2011, Free Software Foundation, Inc. --
-- Copyright (C) 1992-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- --
@ -460,12 +460,12 @@ package Stand is
-----------------
procedure Tree_Read;
-- Initializes entity values in this package from the current tree
-- file using Osint.Tree_Read. Note that Tree_Read includes all the
-- initialization that is carried out by Create_Standard.
-- Initializes entity values in this package from the current tree file
-- using Tree_IO. Note that Tree_Read includes all the initialization that
-- is carried out by Create_Standard.
procedure Tree_Write;
-- Writes out the entity values in this package to the current tree file
-- using Osint.Tree_Write.
-- using Tree_IO.
end Stand;