+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.