From 8dc10d38ccd5b19f4437671102cc18c60919c221 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Wed, 6 May 2009 11:13:27 +0200 Subject: [PATCH] [multiple changes] 2009-05-06 Robert Dewar * freeze.adb (Freeze_Record_Type): Implement Implicit_Packing for records * gnat_rm.texi: Add documentation for pragma Implicit_Packing applied to record types. 2009-05-06 Ed Schonberg * sem.adb (Walk_Library_Items): Place all with_clauses of an instantiation on the spec, because late instance bodies may generate with_clauses for the instance body but are inserted in the instance spec. From-SVN: r147158 --- gcc/ada/ChangeLog | 16 ++++++++++++++++ gcc/ada/freeze.adb | 40 +++++++++++++++++++++++++++++++++++++--- gcc/ada/gnat_rm.texi | 18 +++++++++++++++++- gcc/ada/sem.adb | 10 +++++++++- 4 files changed, 79 insertions(+), 5 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index ce1ae87..4283d89 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,19 @@ +2009-05-06 Robert Dewar + + * freeze.adb (Freeze_Record_Type): Implement Implicit_Packing for + records + + * gnat_rm.texi: + Add documentation for pragma Implicit_Packing applied to record + types. + +2009-05-06 Ed Schonberg + + * sem.adb (Walk_Library_Items): Place all with_clauses of an + instantiation on the spec, because late instance bodies may generate + with_clauses for the instance body but are inserted in the instance + spec. + 2009-05-06 Emmanuel Briot * prj-nmsc.adb (Locate_Directory): Remove unused parameters, and add diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index 7d6491b..fa27be5 100644 --- a/gcc/ada/freeze.adb +++ b/gcc/ada/freeze.adb @@ -1,4 +1,4 @@ ------------------------------------------------------------------------------ +------------------------------------------------------------------------------ -- -- -- GNAT COMPILER COMPONENTS -- -- -- @@ -1545,7 +1545,16 @@ package body Freeze is Placed_Component : Boolean := False; -- Set True if we find at least one component with a component - -- clause (used to warn about useless Bit_Order pragmas). + -- clause (used to warn about useless Bit_Order pragmas, and also + -- to detect cases where Implicit_Packing may have an effect). + + All_Scalar_Components : Boolean := True; + -- Set False if we encounter a component of a non-scalar type + + Scalar_Component_Total_RM_Size : Uint := Uint_0; + Scalar_Component_Total_Esize : Uint := Uint_0; + -- Accumulates total RM_Size values and total Esize values of all + -- scalar components. Used for processing of Implicit_Packing. function Check_Allocator (N : Node_Id) return Node_Id; -- If N is an allocator, possibly wrapped in one or more level of @@ -1855,6 +1864,19 @@ package body Freeze is end; end if; + -- Processing for possible Implicit_Packing later + + if Implicit_Packing then + if not Is_Scalar_Type (Etype (Comp)) then + All_Scalar_Components := False; + else + Scalar_Component_Total_RM_Size := + Scalar_Component_Total_RM_Size + RM_Size (Etype (Comp)); + Scalar_Component_Total_Esize := + Scalar_Component_Total_Esize + Esize (Etype (Comp)); + end if; + end if; + -- If the component is an Itype with Delayed_Freeze and is either -- a record or array subtype and its base type has not yet been -- frozen, we must remove this from the entity list of this @@ -2061,7 +2083,7 @@ package body Freeze is -- Finally, enforce the restriction that access attributes with a -- current instance prefix can only apply to limited types. - if Ekind (Rec) = E_Record_Type then + if Ekind (Rec) = E_Record_Type then if Present (Corresponding_Remote_Type (Rec)) then Freeze_And_Append (Corresponding_Remote_Type (Rec), Loc, Result); @@ -2163,6 +2185,18 @@ package body Freeze is end if; end; end if; + + -- Apply implicit packing if all conditions are met + + if Implicit_Packing + and then Has_Size_Clause (Rec) + and then All_Scalar_Components + and then not Has_Discriminants (Rec) + and then Esize (Rec) < Scalar_Component_Total_Esize + and then Esize (Rec) >= Scalar_Component_Total_RM_Size + then + Set_Is_Packed (Rec); + end if; end Freeze_Record_Type; -- Start of processing for Freeze_Entity diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi index 0f7bd74..0e126c3 100644 --- a/gcc/ada/gnat_rm.texi +++ b/gcc/ada/gnat_rm.texi @@ -2409,7 +2409,8 @@ pragma Implicit_Packing; @noindent This is a configuration pragma that requests implicit packing for packed arrays for which a size clause is given but no explicit pragma Pack or -specification of Component_Size is present. Consider this example: +specification of Component_Size is present. It also applies to records +where no record representation clause is present. Consider this example: @smallexample @c ada type R is array (0 .. 7) of Boolean; @@ -2431,6 +2432,21 @@ specify the exact size that corresponds to the length of the array multiplied by the size in bits of the component type. @cindex Array packing +Similarly, the following example shows the use in the record case + +@smallexample @c ada +type r is record + a, b, c, d, e, f, g, h : boolean; + chr : character; +end record; +for r'size use 16; +@end smallexample + +@noindent +Without a pragma Pack, each Boolean field requires 8 bits, so the +minimum size is 72 bits, but with a pragma Pack, 16 bits would be +sufficient. The use of pragma Implciit_Packing allows this record +declaration to compile without an explicit pragma Pack. @node Pragma Import_Exception @unnumberedsec Pragma Import_Exception @cindex OpenVMS diff --git a/gcc/ada/sem.adb b/gcc/ada/sem.adb index 084a720..0474604 100644 --- a/gcc/ada/sem.adb +++ b/gcc/ada/sem.adb @@ -1760,7 +1760,7 @@ package body Sem is -- If it's a body, then ignore it, unless it's an instance (in -- which case we do the spec), or it's the main unit (in which -- case we do it). Note that it could be both, in which case we - -- do the spec first. + -- do the with_clauses of spec and body first, when N_Package_Body | N_Subprogram_Body => declare @@ -1783,7 +1783,15 @@ package body Sem is if Is_Generic_Instance (Entity) then declare Spec_Unit : constant Node_Id := Library_Unit (CU); + begin + -- Move context of body to that of spec, so it + -- appears before the spec itself, in case it + -- contains nested instances that generate late + -- with_clauses that got attached to the body. + + Append_List + (Context_Items (CU), Context_Items (Spec_Unit)); Do_Unit_And_Dependents (Spec_Unit, Unit (Spec_Unit)); end; -- 2.7.4