* einfo.adb (Proper_First_Index): Moved from Sem_Util.
* einfo.ads: Add new synthesized attribute Proper_First_Index
along with usage in nodes.
(Proper_First_Index): Moved from Sem_Util.
* sem_util.ads, sem_util.adb (Proper_First_Index): Moved to Einfo.
2012-04-26 Gary Dismukes <dismukes@adacore.com>
* layout.adb (Layout_Component_List): Test for the case of a
single variant and the size of its component list was computed
as an integer literal, and use that size (which is in bits)
as is rather than converting to storage units.
2012-04-26 Robert Dewar <dewar@adacore.com>
* exp_aggr.adb: Minor reformatting.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@186866
138bc75d-0d04-0410-961f-
82ee72b054a4
+2012-04-26 Hristian Kirtchev <kirtchev@adacore.com>
+
+ * einfo.adb (Proper_First_Index): Moved from Sem_Util.
+ * einfo.ads: Add new synthesized attribute Proper_First_Index
+ along with usage in nodes.
+ (Proper_First_Index): Moved from Sem_Util.
+ * sem_util.ads, sem_util.adb (Proper_First_Index): Moved to Einfo.
+
+2012-04-26 Gary Dismukes <dismukes@adacore.com>
+
+ * layout.adb (Layout_Component_List): Test for the case of a
+ single variant and the size of its component list was computed
+ as an integer literal, and use that size (which is in bits)
+ as is rather than converting to storage units.
+
+2012-04-26 Robert Dewar <dewar@adacore.com>
+
+ * exp_aggr.adb: Minor reformatting.
+
2012-04-26 Robert Dewar <dewar@adacore.com>
* sem_util.adb: Minor reformatting.
and then Present (Prival_Link (Id)));
end Is_Prival;
+ ------------------------
+ -- Proper_First_Index --
+ ------------------------
+
+ function Proper_First_Index (Id : E) return E is
+ Typ : Entity_Id;
+
+ begin
+ Typ := Id;
+
+ -- The First_Index field is always empty for string literals, use the
+ -- base type instead.
+
+ if Ekind (Typ) = E_String_Literal_Subtype then
+ Typ := Base_Type (Typ);
+ end if;
+
+ return First_Index (Typ);
+ end Proper_First_Index;
+
----------------------------
-- Is_Protected_Component --
----------------------------
-- conditions are present. The precondition_wrapper body is the original
-- entry call, decorated with the given precondition for the entry.
--- Primitive_Operations (synthesized)
--- Present in concurrent types, tagged record types and subtypes, tagged
--- private types and tagged incomplete types. For concurrent types whose
--- Corresponding_Record_Type (CRT) is available, returns the list of
--- Direct_Primitive_Operations of its CRT; otherwise returns No_Elist.
--- For all the other types returns the Direct_Primitive_Operations.
-
-- Predicate_Function (synthesized)
-- Present in all types. Set for types for which (Has_Predicates is True)
-- and for which a predicate procedure has been built that tests that the
-- Note: the reason this is marked as a synthesized attribute is that the
-- way this is stored is as an element of the Subprograms_For_Type field.
+-- Primitive_Operations (synthesized)
+-- Present in concurrent types, tagged record types and subtypes, tagged
+-- private types and tagged incomplete types. For concurrent types whose
+-- Corresponding_Record_Type (CRT) is available, returns the list of
+-- Direct_Primitive_Operations of its CRT; otherwise returns No_Elist.
+-- For all the other types returns the Direct_Primitive_Operations.
+
-- Prival (Node17)
-- Present in private components of protected types. Refers to the entity
-- of the component renaming declaration generated inside protected
-- in the shadow entity, it points to the proper location in which to
-- restore the private view saved in the shadow.
+-- Proper_First_Index (synthesized)
+-- Applies to array types and subtypes. Returns the First_Index of the
+-- type unless it is a string literal. In that case, the First_Index is
+-- obtained from the base type.
+
-- Protected_Formal (Node22)
-- Present in formal parameters (in, in out and out parameters). Used
-- only for formals of protected operations. References corresponding
-- Is_Constrained (Flag12)
-- Next_Index (synth)
-- Number_Dimensions (synth)
+ -- Proper_First_Index (synth)
-- (plus type attributes)
-- E_Block
-- Is_Constrained (Flag12)
-- Next_Index (synth)
-- Number_Dimensions (synth)
+ -- Proper_First_Index (synth)
-- (plus type attributes)
-- E_String_Literal_Subtype
-- String_Literal_Length (Uint16)
-- First_Index (Node17) (always Empty)
-- Packed_Array_Type (Node23)
+ -- Proper_First_Index (synth)
-- (plus type attributes)
-- E_Subprogram_Body
function Number_Formals (Id : E) return Pos;
function Parameter_Mode (Id : E) return Formal_Kind;
function Primitive_Operations (Id : E) return L;
+ function Proper_First_Index (Id : E) return E;
function Root_Type (Id : E) return E;
function Safe_Emax_Value (Id : E) return U;
function Safe_First_Value (Id : E) return R;
-- At this stage we have a suitable aggregate for handling at compile
-- time (the only remaining checks are that the values of expressions
- -- in the aggregate are compile time known (check is performed by
- -- Get_Component_Val), and that any subtypes or ranges are statically
- -- known.
+ -- in the aggregate are compile-time known, checks are performed by
+ -- Get_Component_Val, and that any subtypes or ranges are statically
+ -- known).
-- If the aggregate is not fully positional at this stage, then
-- convert it to positional form. Either this will fail, in which
exit;
elsif Is_Record_Type (Etype (Enclosing_Aggregate))
- and then Reverse_Storage_Order
- (Etype (Enclosing_Aggregate))
+ and then Reverse_Storage_Order (Etype (Enclosing_Aggregate))
then
In_Reverse_Storage_Order_Record := True;
exit;
end if;
+
Enclosing_Aggregate := Parent (Enclosing_Aggregate);
end loop;
-- value. For big endian we fill up the high order bits of the
-- target value (which is a left justified modular value).
+ -- Above comment needs extending for the code below, which is by
+ -- the way incomprehensible, I have no idea what a xor b xor c
+ -- means, and it hurts my brain to try to figure it out???
+ -- Let's introduce a new variable, perhaps Effectively_Big_Endian
+ -- and compute it with clearer code ???
+
if Bytes_Big_Endian
- xor Debug_Flag_8
- xor In_Reverse_Storage_Order_Record
+ xor Debug_Flag_8
+ xor In_Reverse_Storage_Order_Record
then
Shift := Csiz * (Len - 1);
Incr := -Csiz;
-- --
-- B o d y --
-- --
--- Copyright (C) 2001-2011, Free Software Foundation, Inc. --
+-- Copyright (C) 2001-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- --
-- others case.
if No (RM_Siz_Expr) then
- RM_Siz_Expr := Bits_To_SU (RM_SizV);
+
+ -- If this is the only variant and the size is a
+ -- literal, then use bit size as is, otherwise convert
+ -- to storage units and continue to the next variant.
+
+ if No (Prev (Var))
+ and then Nkind (RM_SizV) = N_Integer_Literal
+ then
+ RM_Siz_Expr := RM_SizV;
+ else
+ RM_Siz_Expr := Bits_To_SU (RM_SizV);
+ end if;
-- Otherwise construct the appropriate test
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;
-
- begin
- Typ := Array_Typ;
-
- 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.