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
+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,
-- 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;
+ -- Reference to the body of a protected subprogram which meets the lock-
+ -- free requirements.
+
+ Comp_Id : Entity_Id;
+ -- Reference to the scalar component referenced from within Sub_Body
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.
- -- The following table establishes a relation between a subprogram body and
- -- an unique protected component referenced in this body.
+ -- 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,
-- 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))
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;
------------------------
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
("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);
-- 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
-- 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
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);
-------------------------
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));
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;
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 --
------------------------------------
-- 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.
-- --
-- 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- --
-----------------
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;
projects / platform / upstream / gcc.git / commitdiff