ali.ads, ali.adb (Optimize_Alignment_Setting): New field in ALI record

2008-03-26  Robert Dewar  <dewar@adacore.com>

	* ali.ads, ali.adb (Optimize_Alignment_Setting): New field in ALI record

	* bcheck.adb (Check_Consistent_Optimize_Alignment): New procedure

	* debug.adb: Add debug flags d.r and d.v
	Add debug flag .T (Optimize_Alignment (Time))
	Add debug flag .S (Optimize_Alignment (Space))

	* freeze.adb (Freeze_Record_Type): Set OK_To_Reorder_Components
	depending on setting of relevant debug flags.
	Replace use of Warnings_Off by Has_Warnings_Off
	(Freeze_Entity): In circuit for warning on suspicious convention
	actuals, do not give warning if subprogram has same entity as formal
	type, or if subprogram does not come from source.
	(Freeze_Entity): Don't reset Is_Packed for fully rep speced record
	if Optimize_Alignment set to Space.

	* frontend.adb: Add call to Sem_Warn.Initialize
	Add call to Sem_Warn.Output_Unused_Warnings_Off_Warnings
	Reset Optimize_Alignment mode from debug switches .S and .T

	* layout.adb (Layout_Composite_Object): Rewritten for
	Optimize_Aligment pragma.

	* lib-writ.ads, lib-writ.adb: New Ox parameter for Optimize_Alignment
	mode.

	* opt.ads, opt.adb: (Optimize_Alignment): New global switch

	* par-prag.adb (N_Pragma): Chars field removed, use Chars
	(Pragma_Identifier (..  instead, adjustments throughout to accomodate
	this change. Add entry for pragma Optimize_Alignment

	* sem_prag.adb (N_Pragma): Chars field removed, use Chars
	(Pragma_Identifier (..
	instead, adjustments throughout to accomodate this change.
	(Process_Compile_Time_Warning_Or_Error): Use !! for generated msg
	(Favor_Top_Level): Use new function Is_Access_Subprogram_Type
	Add implementation of pragma Optimize_Alignment

From-SVN: r133549

gcc/ada/ali.adb

@@ -818,6 +818,7 @@ package body ALI is
         No_Object                  => False,
         Normalize_Scalars          => False,
         Ofile_Full_Name            => Full_Object_File_Name,
+        Optimize_Alignment_Setting => 'O',
         Queuing_Policy             => ' ',
         Restrictions               => No_Restrictions,
         SAL_Interface              => False,
@@ -1040,6 +1041,11 @@ package body ALI is
                   Fatal_Error_Ignore;
                end if;
 
+            --  Processing for Ox
+
+            elsif C = 'O' then
+               ALIs.Table (Id).Optimize_Alignment_Setting := Getc;
+
             --  Processing for Qx
 
             elsif C = 'Q' then

gcc/ada/ali.ads

@@ -122,82 +122,83 @@ package ALI is
       --  Id of last Sdep table entry for this file
 
       Main_Program : Main_Program_Type;
-      --  Indicator of whether first unit can be used as main program.
-      --  Not set if 'M' appears in Ignore_Lines.
+      --  Indicator of whether first unit can be used as main program. Not set
+      --  if 'M' appears in Ignore_Lines.
 
       Main_Priority : Int;
-      --  Indicates priority value if Main_Program field indicates that
-      --  this can be a main program. A value of -1 (No_Main_Priority)
-      --  indicates that no parameter was found, or no M line was present.
-      --  Not set if 'M' appears in Ignore_Lines.
+      --  Indicates priority value if Main_Program field indicates that this
+      --  can be a main program. A value of -1 (No_Main_Priority) indicates
+      --  that no parameter was found, or no M line was present. Not set if
+      --  'M' appears in Ignore_Lines.
 
       Time_Slice_Value : Int;
       --  Indicates value of time slice parameter from T=xxx on main program
-      --  line. A value of -1 indicates that no T=xxx parameter was found,
-      --  or no M line was present.
-      --  Not set if 'M' appears in Ignore_Lines.
+      --  line. A value of -1 indicates that no T=xxx parameter was found, or
+      --  no M line was present. Not set if 'M' appears in Ignore_Lines.
 
       WC_Encoding : Character;
       --  Wide character encoding if main procedure. Otherwise not relevant.
       --  Not set if 'M' appears in Ignore_Lines.
 
       Locking_Policy : Character;
-      --  Indicates locking policy for units in this file. Space means
-      --  tasking was not used, or that no Locking_Policy pragma was
-      --  present or that this is a language defined unit. Otherwise set
-      --  to first character (upper case) of policy name.
-      --  Not set if 'P' appears in Ignore_Lines.
+      --  Indicates locking policy for units in this file. Space means tasking
+      --  was not used, or that no Locking_Policy pragma was present or that
+      --  this is a language defined unit. Otherwise set to first character
+      --  (upper case) of policy name. Not set if 'P' appears in Ignore_Lines.
 
       Queuing_Policy : Character;
-      --  Indicates queuing policy for units in this file. Space means
-      --  tasking was not used, or that no Queuing_Policy pragma was
-      --  present or that this is a language defined unit. Otherwise set
-      --  to first character (upper case) of policy name.
-      --  Not set if 'P' appears in Ignore_Lines.
+      --  Indicates queuing policy for units in this file. Space means tasking
+      --  was not used, or that no Queuing_Policy pragma was present or that
+      --  this is a language defined unit. Otherwise set to first character
+      --  (upper case) of policy name. Not set if 'P' appears in Ignore_Lines.
 
       Task_Dispatching_Policy : Character;
-      --  Indicates task dispatching policy for units in this file. Space
-      --  means tasking was not used, or that no Task_Dispatching_Policy
-      --  pragma was present or that this is a language defined unit.
-      --  Otherwise set to first character (upper case) of policy name.
-      --  Not set if 'P' appears in Ignore_Lines.
+      --  Indicates task dispatching policy for units in this file. Space means
+      --  tasking was not used, or that no Task_Dispatching_Policy pragma was
+      --  present or that this is a language defined unit. Otherwise set to
+      --  first character (upper case) of policy name. Not set if 'P' appears
+      --  in Ignore_Lines.
 
       Compile_Errors : Boolean;
-      --  Set to True if compile errors for unit. Note that No_Object
-      --  will always be set as well in this case.
-      --  Not set if 'P' appears in Ignore_Lines.
+      --  Set to True if compile errors for unit. Note that No_Object will
+      --  always be set as well in this case. Not set if 'P' appears in
+      --  Ignore_Lines.
 
       Float_Format : Character;
-      --  Set to float format (set to I if no float-format given).
-      --  Not set if 'P' appears in Ignore_Lines.
+      --  Set to float format (set to I if no float-format given). Not set if
+      --  'P' appears in Ignore_Lines.
 
       No_Object : Boolean;
-      --  Set to True if no object file generated.
-      --  Not set if 'P' appears in Ignore_Lines.
+      --  Set to True if no object file generated. Not set if 'P' appears in
+      --  Ignore_Lines.
 
       Normalize_Scalars : Boolean;
-      --  Set to True if file was compiled with Normalize_Scalars.
-      --  Not set if 'P' appears in Ignore_Lines.
+      --  Set to True if file was compiled with Normalize_Scalars. Not set if
+      --  'P' appears in Ignore_Lines.
+
+      Optimize_Alignment_Setting : Character;
+      --  Optimize_Alignment setting. Set to S/T if OS/OT parameters present,
+      --  otherwise set to 'O' (S/T/O = Space/Time/Off). Not set if 'P' appears
+      --  in Ignore_Lines.
 
       Unit_Exception_Table : Boolean;
-      --  Set to True if unit exception table pointer generated.
-      --  Not set if 'P' appears in Ignore_Lines.
+      --  Set to True if unit exception table pointer generated. Not set if 'P'
+      --  appears in Ignore_Lines.
 
       Zero_Cost_Exceptions : Boolean;
-      --  Set to True if file was compiled with zero cost exceptions.
-      --  Not set if 'P' appears in Ignore_Lines.
+      --  Set to True if file was compiled with zero cost exceptions. Not set
+      --  if 'P' appears in Ignore_Lines.
 
       Restrictions : Restrictions_Info;
       --  Restrictions information reconstructed from R lines
 
       First_Interrupt_State : Interrupt_State_Id;
       Last_Interrupt_State  : Interrupt_State_Id'Base;
-      --  These point to the first and last entries in the interrupt
-      --  state table for this unit. If there are no entries, then
-      --  Last_Interrupt_State = First_Interrupt_State - 1 (that's
-      --  why the 'Base reference is there, it can be one less than
-      --  the lower bound of the subtype).
-      --  Not set if 'I' appears in Ignore_Lines
+      --  These point to the first and last entries in the interrupt state
+      --  table for this unit. If no entries, then Last_Interrupt_State =
+      --  First_Interrupt_State - 1 (that's why the 'Base reference is there,
+      --  it can be one less than the lower bound of the subtype). Not set if
+      --  'I' appears in Ignore_Lines
 
       First_Specific_Dispatching : Priority_Specific_Dispatching_Id;
       Last_Specific_Dispatching  : Priority_Specific_Dispatching_Id'Base;

gcc/ada/bcheck.adb

@@ -51,6 +51,7 @@ package body Bcheck is
    procedure Check_Consistent_Interrupt_States;
    procedure Check_Consistent_Locking_Policy;
    procedure Check_Consistent_Normalize_Scalars;
+   procedure Check_Consistent_Optimize_Alignment;
    procedure Check_Consistent_Queuing_Policy;
    procedure Check_Consistent_Restrictions;
    procedure Check_Consistent_Zero_Cost_Exception_Handling;
@@ -86,8 +87,8 @@ package body Bcheck is
       end if;
 
       Check_Consistent_Normalize_Scalars;
+      Check_Consistent_Optimize_Alignment;
       Check_Consistent_Dynamic_Elaboration_Checking;
-
       Check_Consistent_Restrictions;
       Check_Consistent_Interrupt_States;
       Check_Consistent_Dispatching_Policy;
@@ -657,12 +658,11 @@ package body Bcheck is
    --  then all other units in the partition must also be compiled with
    --  Normalized_Scalars in effect.
 
-   --  There is some issue as to whether this consistency check is
-   --  desirable, it is certainly required at the moment by the RM.
-   --  We should keep a watch on the ARG and HRG deliberations here.
-   --  GNAT no longer depends on this consistency (it used to do so,
-   --  but that has been corrected in the latest version, since the
-   --  Initialize_Scalars pragma does not require consistency.
+   --  There is some issue as to whether this consistency check is desirable,
+   --  it is certainly required at the moment by the RM. We should keep a watch
+   --  on the ARG and HRG deliberations here. GNAT no longer depends on this
+   --  consistency (it used to do so, but that is no longer the case, since
+   --  pragma Initialize_Scalars pragma does not require consistency.)
 
    procedure Check_Consistent_Normalize_Scalars is
    begin
@@ -696,6 +696,44 @@ package body Bcheck is
       end if;
    end Check_Consistent_Normalize_Scalars;
 
+   -----------------------------------------
+   -- Check_Consistent_Optimize_Alignment --
+   -----------------------------------------
+
+   --  The rule is that all units other than internal units must be compiled
+   --  with the same setting for Optimize_Alignment. We can exclude internal
+   --  units since they are forced to compile with Optimize_Alignment (Off).
+
+   procedure Check_Consistent_Optimize_Alignment is
+      OA_Setting : Character := ' ';
+      --  Reset when we find a non-internal unit
+
+      OA_Unit : ALI_Id;
+      --  Id of unit from which OA_Setting was set
+
+   begin
+      for A in ALIs.First .. ALIs.Last loop
+         if not Is_Internal_File_Name (ALIs.Table (A).Afile) then
+            if OA_Setting = ' ' then
+               OA_Setting := ALIs.Table (A).Optimize_Alignment_Setting;
+               OA_Unit := A;
+
+            elsif OA_Setting = ALIs.Table (A).Optimize_Alignment_Setting then
+               null;
+
+            else
+               Error_Msg_File_1 := ALIs.Table (OA_Unit).Sfile;
+               Error_Msg_File_2 := ALIs.Table (A).Sfile;
+
+               Consistency_Error_Msg
+                 ("{ and { compiled with different "
+                  & "Optimize_Alignment settings");
+               return;
+            end if;
+         end if;
+      end loop;
+   end Check_Consistent_Optimize_Alignment;
+
    -------------------------------------
    -- Check_Consistent_Queuing_Policy --
    -------------------------------------

gcc/ada/debug.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2007, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2008, 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- --
@@ -93,7 +93,7 @@ package body Debug is
    --  dY   Enable configurable run-time mode
    --  dZ   Generate listing showing the contents of the dispatch tables
 
-   --  d.a  Disable OpenVMS alignment optimization on types
+   --  d.a
    --  d.b
    --  d.c
    --  d.d
@@ -110,11 +110,11 @@ package body Debug is
    --  d.o
    --  d.p
    --  d.q
-   --  d.r
+   --  d.r  Enable OK_To_Reorder_Components in non-variant records
    --  d.s  Disable expansion of slice move, use memmove
    --  d.t  Disable static allocation of library level dispatch tables
    --  d.u
-   --  d.v
+   --  d.v  Enable OK_To_Reorder_Components in variant records
    --  d.w  Do not check for infinite while loops
    --  d.x  No exception handlers
    --  d.y
@@ -138,8 +138,8 @@ package body Debug is
    --  d.P
    --  d.Q
    --  d.R
-   --  d.S
-   --  d.T
+   --  d.S  Force Optimize_Alignment (Space)
+   --  d.T  Force Optimize_Alignment (Time)
    --  d.U
    --  d.V
    --  d.W
@@ -474,33 +474,32 @@ package body Debug is
    --       line has an internally generated number used for references between
    --       tagged types and primitives. For each primitive the output has the
    --       following fields:
+   --
    --         - Letter 'P' or letter 's': The former indicates that this
    --           primitive will be located in a primary dispatch table. The
    --           latter indicates that it will be located in a secondary
    --           dispatch table.
+   --
    --         - Name of the primitive. In case of predefined Ada primitives
    --           the text "(predefined)" is added before the name, and these
    --           acronyms are used: SR (Stream_Read), SW (Stream_Write), SI
    --           (Stream_Input), SO (Stream_Output), DA (Deep_Adjust), DF
    --           (Deep_Finalize). In addition Oeq identifies the equality
    --           operator, and "_assign" the assignment.
+   --
    --         - If the primitive covers interface types, two extra fields
    --           referencing other primitives are generated: "Alias" references
    --           the primitive of the tagged type that covers an interface
    --           primitive, and "AI_Alias" references the covered interface
    --           primitive.
+   --
    --         - The expression "at #xx" indicates the slot of the dispatch
    --           table occupied by such primitive in its corresponding primary
    --           or secondary dispatch table.
+   --
    --         - In case of abstract subprograms the text "is abstract" is
    --           added at the end of the line.
 
-   --  d.a  Disable OpenVMS alignment optimization on types.  On OpenVMS,
-   --       record types whose size is odd "in between" (e.g. 17 bits) are
-   --       over-aligned to the next power of 2 (until 8 bytes).  This over
-   --       alignment improve generated code and is more consistent with
-   --       what Dec Ada does.
-
    --  d.f  Suppress folding of static expressions. This of course results
    --       in seriously non-conforming behavior, but is useful sometimes
    --       when tracking down handling of complex expressions.
@@ -520,6 +519,9 @@ package body Debug is
    --       main source (this corresponds to a previous behavior of -gnatl and
    --       is used for running the ACATS tests).
 
+   --  d.r  Forces the flag OK_To_Reorder_Components to be set in all record
+   --       base types that have no discriminants.
+
    --  d.s  Normally the compiler expands slice moves into loops if overlap
    --       might be possible. This debug flag inhibits that expansion, and
    --       the back end is expected to use an appropriate routine to handle
@@ -531,6 +533,9 @@ package body Debug is
    --       previous dynamic construction of tables. It is there as a possible
    --       work around if we run into trouble with the new implementation.
 
+   --  d.v  Forces the flag OK_To_Reorder_Components to be set in all record
+   --       base types that have at least one discriminant (v = variant).
+
    --  d.w  This flag turns off the scanning of while loops to detect possible
    --       infinite loops.
 
@@ -543,6 +548,10 @@ package body Debug is
    --       byte code, even in case of unsupported construct, for the sake
    --       of static analysis tools.
 
+   --  d.S  Force Optimize_Alignment (Space) mode as the default
+
+   --  d.T  Force Optimize_Alignment (Time) mode as the default
+
    --  d1   Error messages have node numbers where possible. Normally error
    --       messages have only source locations. This option is useful when
    --       debugging errors caused by expanded code, where the source location

gcc/ada/freeze.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2007, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2008, 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- --
@@ -155,14 +155,8 @@ package body Freeze is
    --  setting of Debug_Info_Needed for the entity. This flag is set if
    --  the entity comes from source, or if we are in Debug_Generated_Code
    --  mode or if the -gnatdV debug flag is set. However, it never sets
-   --  the flag if Debug_Info_Off is set.
-
-   procedure Set_Debug_Info_Needed (T : Entity_Id);
-   --  Sets the Debug_Info_Needed flag on entity T if not already set, and
-   --  also on any entities that are needed by T (for an object, the type
-   --  of the object is needed, and for a type, the subsidiary types are
-   --  needed -- see body for details). Never has any effect on T if the
-   --  Debug_Info_Off flag is set.
+   --  the flag if Debug_Info_Off is set. This procedure also ensures that
+   --  subsidiary entities have the flag set as required.
 
    procedure Undelay_Type (T : Entity_Id);
    --  T is a type of a component that we know to be an Itype.
@@ -956,12 +950,13 @@ package body Freeze is
 
    procedure Check_Debug_Info_Needed (T : Entity_Id) is
    begin
-      if Needs_Debug_Info (T) or else Debug_Info_Off (T) then
+      if Debug_Info_Off (T) then
          return;
 
       elsif Comes_From_Source (T)
         or else Debug_Generated_Code
         or else Debug_Flag_VV
+        or else Needs_Debug_Info (T)
       then
          Set_Debug_Info_Needed (T);
       end if;
@@ -1856,7 +1851,7 @@ package body Freeze is
             then
                declare
                   Will_Be_Frozen : Boolean := False;
-                  S : Entity_Id := Scope (Rec);
+                  S              : Entity_Id;
 
                begin
                   --  We have a pretty bad kludge here. Suppose Rec is subtype
@@ -1874,6 +1869,7 @@ package body Freeze is
                   --  do, then mark that Comp'Base will actually be frozen. If
                   --  so, we merely undelay it.
 
+                  S := Scope (Rec);
                   while Present (S) loop
                      if Is_Subprogram (S) then
                         Will_Be_Frozen := True;
@@ -1994,14 +1990,31 @@ package body Freeze is
             end if;
          end if;
 
+         --  Set OK_To_Reorder_Components depending on debug flags
+
+         if Rec = Base_Type (Rec)
+           and then Convention (Rec) = Convention_Ada
+         then
+            if (Has_Discriminants (Rec) and then Debug_Flag_Dot_V)
+                  or else
+               (not Has_Discriminants (Rec) and then Debug_Flag_Dot_R)
+            then
+               Set_OK_To_Reorder_Components (Rec);
+            end if;
+         end if;
+
          --  Check for useless pragma Pack when all components placed. We only
          --  do this check for record types, not subtypes, since a subtype may
          --  have all its components placed, and it still makes perfectly good
-         --  sense to pack other subtypes or the parent type.
+         --  sense to pack other subtypes or the parent type. We do not give
+         --  this warning if Optimize_Alignment is set to Space, since the
+         --  pragma Pack does have an effect in this case (it always resets
+         --  the alignment to one).
 
          if Ekind (Rec) = E_Record_Type
            and then Is_Packed (Rec)
            and then not Unplaced_Component
+           and then Optimize_Alignment /= 'S'
          then
             --  Reset packed status. Probably not necessary, but we do it so
             --  that there is no chance of the back end doing something strange
@@ -2093,16 +2106,19 @@ package body Freeze is
 
          --  Generate warning for applying C or C++ convention to a record
          --  with discriminants. This is suppressed for the unchecked union
-         --  case, since the whole point in this case is interface C.
+         --  case, since the whole point in this case is interface C. We also
+         --  do not generate this within instantiations, since we will have
+         --  generated a message on the template.
 
          if Has_Discriminants (E)
            and then not Is_Unchecked_Union (E)
-           and then not Warnings_Off (E)
-           and then not Warnings_Off (Base_Type (E))
            and then (Convention (E) = Convention_C
                        or else
                      Convention (E) = Convention_CPP)
            and then Comes_From_Source (E)
+           and then not In_Instance
+           and then not Has_Warnings_Off (E)
+           and then not Has_Warnings_Off (Base_Type (E))
          then
             declare
                Cprag : constant Node_Id := Get_Rep_Pragma (E, Name_Convention);
@@ -2330,16 +2346,18 @@ package body Freeze is
                      end if;
 
                      --  Check suspicious parameter for C function. These tests
-                     --  apply only to exported/imported suboprograms.
+                     --  apply only to exported/imported subprograms.
 
                      if Warn_On_Export_Import
+                       and then Comes_From_Source (E)
                        and then (Convention (E) = Convention_C
                                    or else
                                  Convention (E) = Convention_CPP)
-                       and then not Warnings_Off (E)
-                       and then not Warnings_Off (F_Type)
-                       and then not Warnings_Off (Formal)
                        and then (Is_Imported (E) or else Is_Exported (E))
+                       and then Convention (E) /= Convention (Formal)
+                       and then not Has_Warnings_Off (E)
+                       and then not Has_Warnings_Off (F_Type)
+                       and then not Has_Warnings_Off (Formal)
                      then
                         Error_Msg_Qual_Level := 1;
 
@@ -2482,14 +2500,14 @@ package body Freeze is
                        and then (Convention (E) = Convention_C
                                    or else
                                  Convention (E) = Convention_CPP)
-                       and then not Warnings_Off (E)
-                       and then not Warnings_Off (R_Type)
                        and then (Is_Imported (E) or else Is_Exported (E))
                      then
                         --  Check suspicious return of fat C pointer
 
                         if Is_Access_Type (R_Type)
                           and then Esize (R_Type) > Ttypes.System_Address_Size
+                          and then not Has_Warnings_Off (E)
+                          and then not Has_Warnings_Off (R_Type)
                         then
                            Error_Msg_N
                              ("?return type of& does not "
@@ -2499,6 +2517,8 @@ package body Freeze is
 
                         elsif Root_Type (R_Type) = Standard_Boolean
                           and then Convention (R_Type) = Convention_Ada
+                          and then not Has_Warnings_Off (E)
+                          and then not Has_Warnings_Off (R_Type)
                         then
                            Error_Msg_N
                              ("?return type of & is an 8-bit "
@@ -2512,6 +2532,8 @@ package body Freeze is
                                              Is_Tagged_Type
                                                (Designated_Type (R_Type))))
                           and then Convention (E) = Convention_C
+                          and then not Has_Warnings_Off (E)
+                          and then not Has_Warnings_Off (R_Type)
                         then
                            Error_Msg_N
                              ("?return type of & does not "
@@ -2521,6 +2543,8 @@ package body Freeze is
 
                         elsif Ekind (R_Type) = E_Access_Subprogram_Type
                           and then not Has_Foreign_Convention (R_Type)
+                          and then not Has_Warnings_Off (E)
+                          and then not Has_Warnings_Off (R_Type)
                         then
                            Error_Msg_N
                              ("?& should return a foreign "
@@ -2537,10 +2561,12 @@ package body Freeze is
                        and then not Is_Imported (E)
                        and then Has_Foreign_Convention (E)
                        and then Warn_On_Export_Import
+                       and then not Has_Warnings_Off (E)
+                       and then not Has_Warnings_Off (Etype (E))
                      then
                         Error_Msg_N
                           ("?foreign convention function& should not " &
-                           "return unconstrained array", E);
+                           "return unconstrained array!", E);
 
                      --  Ada 2005 (AI-326): Check wrong use of tagged
                      --  incomplete type
@@ -5233,7 +5259,6 @@ package body Freeze is
 
          Next_Formal (Formal);
       end loop;
-
    end Process_Default_Expressions;
 
    ----------------------------------------
@@ -5266,65 +5291,6 @@ package body Freeze is
       end if;
    end Set_Component_Alignment_If_Not_Set;
 
-   ---------------------------
-   -- Set_Debug_Info_Needed --
-   ---------------------------
-
-   procedure Set_Debug_Info_Needed (T : Entity_Id) is
-   begin
-      if No (T)
-        or else Needs_Debug_Info (T)
-        or else Debug_Info_Off (T)
-      then
-         return;
-      else
-         Set_Needs_Debug_Info (T);
-      end if;
-
-      if Is_Object (T) then
-         Set_Debug_Info_Needed (Etype (T));
-
-      elsif Is_Type (T) then
-         Set_Debug_Info_Needed (Etype (T));
-
-         if Is_Record_Type (T) then
-            declare
-               Ent : Entity_Id := First_Entity (T);
-            begin
-               while Present (Ent) loop
-                  Set_Debug_Info_Needed (Ent);
-                  Next_Entity (Ent);
-               end loop;
-            end;
-
-         elsif Is_Array_Type (T) then
-            Set_Debug_Info_Needed (Component_Type (T));
-
-            declare
-               Indx : Node_Id := First_Index (T);
-            begin
-               while Present (Indx) loop
-                  Set_Debug_Info_Needed (Etype (Indx));
-                  Indx := Next_Index (Indx);
-               end loop;
-            end;
-
-            if Is_Packed (T) then
-               Set_Debug_Info_Needed (Packed_Array_Type (T));
-            end if;
-
-         elsif Is_Access_Type (T) then
-            Set_Debug_Info_Needed (Directly_Designated_Type (T));
-
-         elsif Is_Private_Type (T) then
-            Set_Debug_Info_Needed (Full_View (T));
-
-         elsif Is_Protected_Type (T) then
-            Set_Debug_Info_Needed (Corresponding_Record_Type (T));
-         end if;
-      end if;
-   end Set_Debug_Info_Needed;
-
    ------------------
    -- Undelay_Type --
    ------------------
@@ -5439,7 +5405,7 @@ package body Freeze is
 
          if Present (Decl)
            and then Nkind (Decl) = N_Pragma
-           and then Chars (Decl) = Name_Import
+           and then Pragma_Name (Decl) = Name_Import
          then
             return;
          end if;

gcc/ada/frontend.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2007, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2008, 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- --
@@ -59,8 +59,8 @@ with Tbuild;   use Tbuild;
 with Types;    use Types;
 
 procedure Frontend is
-      Config_Pragmas : List_Id;
-      --  Gather configuration pragmas
+   Config_Pragmas : List_Id;
+   --  Gather configuration pragmas
 
 begin
    --  Carry out package initializations. These are initializations which
@@ -78,6 +78,7 @@ begin
    Sem_Ch8.Initialize;
    Fname.UF.Initialize;
    Checks.Initialize;
+   Sem_Warn.Initialize;
 
    --  Create package Standard
 
@@ -207,6 +208,14 @@ begin
       Fmap.Initialize (Mapping_File_Name.all);
    end if;
 
+   --  Adjust Optimize_Alignment mode from debug switches if necessary
+
+   if Debug_Flag_Dot_SS then
+      Optimize_Alignment := 'S';
+   elsif Debug_Flag_Dot_TT then
+      Optimize_Alignment := 'T';
+   end if;
+
    --  We have now processed the command line switches, and the gnat.adc
    --  file, so this is the point at which we want to capture the values
    --  of the configuration switches (see Opt for further details).
@@ -326,6 +335,7 @@ begin
          Sem_Warn.Output_Non_Modifed_In_Out_Warnings;
          Sem_Warn.Output_Unreferenced_Messages;
          Sem_Warn.Check_Unused_Withs;
+         Sem_Warn.Output_Unused_Warnings_Off_Warnings;
       end if;
    end if;
 

gcc/ada/layout.adb

@@ -2794,7 +2794,32 @@ package body Layout is
       Align : Nat;
 
    begin
-      if Unknown_Alignment (E) then
+      --  If alignment is already set, then nothing to do
+
+      if Known_Alignment (E) then
+         return;
+      end if;
+
+      --  Alignment is not known, see if we can set it, taking into account
+      --  the setting of the Optimize_Alignment mode.
+
+      --  If Optimize_Alignment is set to Space, then packed records always
+      --  have an aligmment of 1. But don't do anything for atomic records
+      --  since we may need higher alignment for indivisible access.
+
+      if Optimize_Alignment = 'S'
+        and then Is_Record_Type (E)
+        and then Is_Packed (E)
+        and then not Is_Atomic (E)
+      then
+         Align := 1;
+
+      --  Not a record, or not packed
+
+      else
+         --  The only other cases we worry about here are where the size is
+         --  staticallly known at compile time.
+
          if Known_Static_Esize (E) then
             Siz := Esize (E);
 
@@ -2809,8 +2834,8 @@ package body Layout is
 
          --  Size is known, alignment is not set
 
-         --  Reset alignment to match size if size is exactly 2, 4, or 8
-         --  storage units.
+         --  Reset alignment to match size if the known size is exactly 2, 4,
+         --  or 8 storage units.
 
          if Siz = 2 * System_Storage_Unit then
             Align := 2;
@@ -2819,54 +2844,75 @@ package body Layout is
          elsif Siz = 8 * System_Storage_Unit then
             Align := 8;
 
-         --  On VMS, also reset for odd "in between" sizes, e.g. a 17-bit
-         --  record is given an alignment of 4. This is more consistent with
-         --  what DEC Ada does (-gnatd.a turns this off which can be used to
-         --  examine the value of this special transformation).
+            --  If Optimize_Alignment is set to Space, then make sure the
+            --  alignment matches the size, for example, if the size is 17
+            --  bytes then we want an alignment of 1 for the type.
+
+         elsif Optimize_Alignment = 'S' then
+            if Siz mod (8 * System_Storage_Unit) = 0 then
+               Align := 8;
+            elsif Siz mod (4 * System_Storage_Unit) = 0 then
+               Align := 4;
+            elsif Siz mod (2 * System_Storage_Unit) = 0 then
+               Align := 2;
+            else
+               Align := 1;
+            end if;
+
+            --  If Optimize_Alignment is set to Time, then we reset for odd
+            --  "in between sizes", for example a 17 bit record is given an
+            --  alignment of 4. Note that this matches the old VMS behavior
+            --  in versions of GNAT prior to 6.1.1.
 
-         elsif OpenVMS_On_Target
-           and then not Debug_Flag_Dot_A
+         elsif Optimize_Alignment = 'T'
            and then Siz > System_Storage_Unit
+           and then Siz <= 8 * System_Storage_Unit
          then
             if Siz <= 2 * System_Storage_Unit then
                Align := 2;
             elsif Siz <= 4 * System_Storage_Unit then
                Align := 4;
-            elsif Siz <= 8 * System_Storage_Unit then
+            else -- Siz <= 8 * System_Storage_Unit then
                Align := 8;
-            else
-               return;
             end if;
 
-         --  No special alignment fiddling needed
+            --  No special alignment fiddling needed
 
          else
             return;
          end if;
+      end if;
 
-         --  Here Align is set to the proposed improved alignment
+      --  Here we have Set Align to the proposed improved value. Make sure the
+      --  value set does not exceed Maximum_Alignment for the target.
 
-         if Align > Maximum_Alignment then
-            Align := Maximum_Alignment;
-         end if;
+      if Align > Maximum_Alignment then
+         Align := Maximum_Alignment;
+      end if;
 
-         --  Further processing for record types only to reduce the alignment
-         --  set by the above processing in some specific cases. We do not
-         --  do this for atomic records, since we need max alignment there.
+      --  Further processing for record types only to reduce the alignment
+      --  set by the above processing in some specific cases. We do not
+      --  do this for atomic records, since we need max alignment there,
 
-         if Is_Record_Type (E) then
+      if Is_Record_Type (E) and then not Is_Atomic (E) then
 
-            --  For records, there is generally no point in setting alignment
-            --  higher than word size since we cannot do better than move by
-            --  words in any case
+         --  For records, there is generally no point in setting alignment
+         --  higher than word size since we cannot do better than move by
+         --  words in any case. Omit this if we are optimizing for time,
+         --  since conceivably we may be able to do better.
 
-            if Align > System_Word_Size / System_Storage_Unit then
-               Align := System_Word_Size / System_Storage_Unit;
-            end if;
+         if Align > System_Word_Size / System_Storage_Unit
+           and then Optimize_Alignment /= 'T'
+         then
+            Align := System_Word_Size / System_Storage_Unit;
+         end if;
 
-            --  Check components. If any component requires a higher
-            --  alignment, then we set that higher alignment in any case.
+         --  Check components. If any component requires a higher alignment,
+         --  then we set that higher alignment in any case. Don't do this if
+         --  we have Optimize_Alignment set to Space. Note that that covers
+         --  the case of packed records, where we arleady set alignment to 1.
 
+         if Optimize_Alignment  /= 'S' then
             declare
                Comp : Entity_Id;
 
@@ -2878,19 +2924,19 @@ package body Layout is
                         Calign : constant Uint := Alignment (Etype (Comp));
 
                      begin
-                        --  The cases to worry about are when the alignment
-                        --  of the component type is larger than the alignment
-                        --  we have so far, and either there is no component
-                        --  clause for the alignment, or the length set by
-                        --  the component clause matches the alignment set.
+                        --  The cases to process are when the alignment of the
+                        --  component type is larger than the alignment we have
+                        --  so far, and either there is no component clause for
+                        --  the component, or the length set by the component
+                        --  clause matches the length of the component type.
 
                         if Calign > Align
                           and then
                             (Unknown_Esize (Comp)
-                               or else (Known_Static_Esize (Comp)
-                                          and then
-                                        Esize (Comp) =
-                                           Calign * System_Storage_Unit))
+                              or else (Known_Static_Esize (Comp)
+                                        and then
+                                         Esize (Comp) =
+                                              Calign * System_Storage_Unit))
                         then
                            Align := UI_To_Int (Calign);
                         end if;
@@ -2901,16 +2947,17 @@ package body Layout is
                end loop;
             end;
          end if;
+      end if;
 
-         --  Set chosen alignment
+      --  Set chosen alignment, and increase Esize if necessary to match
+      --  the chosen alignment.
 
-         Set_Alignment (E, UI_From_Int (Align));
+      Set_Alignment (E, UI_From_Int (Align));
 
-         if Known_Static_Esize (E)
-           and then Esize (E) < Align * System_Storage_Unit
-         then
-            Set_Esize (E, UI_From_Int (Align * System_Storage_Unit));
-         end if;
+      if Known_Static_Esize (E)
+        and then Esize (E) < Align * System_Storage_Unit
+      then
+         Set_Esize (E, UI_From_Int (Align * System_Storage_Unit));
       end if;
    end Set_Composite_Alignment;
 

gcc/ada/lib-writ.adb

@@ -971,6 +971,11 @@ package body Lib.Writ is
          Write_Info_Str (" NS");
       end if;
 
+      if Optimize_Alignment /= 'O' then
+         Write_Info_Str (" O");
+         Write_Info_Char (Optimize_Alignment);
+      end if;
+
       if Sec_Stack_Used then
          Write_Info_Str (" SS");
       end if;

gcc/ada/lib-writ.ads

@@ -209,7 +209,11 @@ package Lib.Writ is
    --              to all units in the file.
    --
    --         NS   Normalize_Scalars pragma in effect for all units in
-   --              this file
+   --              this file.
+   --
+   --         OS   Optimize_Alignment (Space) active for all units in this file
+   --
+   --         OT   Optimize_Alignment (Time) active for all units in this file
    --
    --         Qx   A valid Queueing_Policy pragma applies to all the units
    --              in this file, where x is the first character (upper case)
@@ -498,15 +502,15 @@ package Lib.Writ is
    --    W unit-name [source-name lib-name] [E] [EA] [ED] [AD]
    --
    --      One of these lines is present for each unit that is mentioned in
-   --      an explicit with clause by the current unit. The first parameter
-   --      is the unit name in internal format. The second parameter is the
-   --      file name of the file that must be compiled to compile this unit.
-   --      It is usually the file for the body, except for packages
-   --      which have no body; for units that need a body, if the source file
-   --      for the body cannot be found, the file name of the spec is used
-   --      instead. The third parameter is the file name of the library
-   --      information file that contains the results of compiling this unit.
-   --      The optional modifiers are used as follows:
+   --      an explicit with clause by the current unit. The first parameter is
+   --      the unit name in internal format. The second parameter is the file
+   --      name of the file that must be compiled to compile this unit. It is
+   --      usually the file for the body, except for packages which have no
+   --      body. For units that need a body, if the source file for the body
+   --      cannot be found, the file name of the spec is used instead. The
+   --      third parameter is the file name of the library information file
+   --      that contains the results of compiling this unit. The optional
+   --      modifiers are used as follows:
    --
    --        E   pragma Elaborate applies to this unit
    --
@@ -528,6 +532,8 @@ package Lib.Writ is
    --      of a generic unit compiled with earlier versions of GNAT which
    --      did not generate object or ali files for generics.
 
+   --  In fact W lines include implicit withs ???
+
    --  -----------------------
    --  -- L  Linker_Options --
    --  -----------------------

gcc/ada/opt.adb

@@ -56,6 +56,7 @@ package body Opt is
       External_Name_Exp_Casing_Config       := External_Name_Exp_Casing;
       External_Name_Imp_Casing_Config       := External_Name_Imp_Casing;
       Fast_Math_Config                      := Fast_Math;
+      Optimize_Alignment_Config             := Optimize_Alignment;
       Persistent_BSS_Mode_Config            := Persistent_BSS_Mode;
       Polling_Required_Config               := Polling_Required;
       Use_VADS_Size_Config                  := Use_VADS_Size;
@@ -77,6 +78,7 @@ package body Opt is
       External_Name_Exp_Casing       := Save.External_Name_Exp_Casing;
       External_Name_Imp_Casing       := Save.External_Name_Imp_Casing;
       Fast_Math                      := Save.Fast_Math;
+      Optimize_Alignment             := Save.Optimize_Alignment;
       Persistent_BSS_Mode            := Save.Persistent_BSS_Mode;
       Polling_Required               := Save.Polling_Required;
       Use_VADS_Size                  := Save.Use_VADS_Size;
@@ -98,6 +100,7 @@ package body Opt is
       Save.External_Name_Exp_Casing       := External_Name_Exp_Casing;
       Save.External_Name_Imp_Casing       := External_Name_Imp_Casing;
       Save.Fast_Math                      := Fast_Math;
+      Save.Optimize_Alignment             := Optimize_Alignment;
       Save.Persistent_BSS_Mode            := Persistent_BSS_Mode;
       Save.Polling_Required               := Polling_Required;
       Save.Use_VADS_Size                  := Use_VADS_Size;
@@ -125,6 +128,7 @@ package body Opt is
          Extensions_Allowed         := True;
          External_Name_Exp_Casing   := As_Is;
          External_Name_Imp_Casing   := Lowercase;
+         Optimize_Alignment         := 'O';
          Persistent_BSS_Mode        := False;
          Use_VADS_Size              := False;
 
@@ -151,12 +155,14 @@ package body Opt is
          External_Name_Exp_Casing   := External_Name_Exp_Casing_Config;
          External_Name_Imp_Casing   := External_Name_Imp_Casing_Config;
          Fast_Math                  := Fast_Math_Config;
+         Optimize_Alignment         := Optimize_Alignment_Config;
          Persistent_BSS_Mode        := Persistent_BSS_Mode_Config;
          Use_VADS_Size              := Use_VADS_Size_Config;
       end if;
 
       Exception_Locations_Suppressed := Exception_Locations_Suppressed_Config;
       Fast_Math                      := Fast_Math_Config;
+      Optimize_Alignment             := Optimize_Alignment_Config;
       Polling_Required               := Polling_Required_Config;
    end Set_Opt_Config_Switches;
 

gcc/ada/opt.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2007, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2008, 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- --
@@ -858,6 +858,10 @@ package Opt is
    --  error is detected then this flag is reset from Generate_Code to
    --  Check_Semantics after generating an error message.
 
+   Optimize_Alignment : Character := 'O';
+   --  Settinng of Optimize_Alignment, set to T/S/O for time/space/off. Can
+   --  be modified by use of pragma Optimize_Alignment.
+
    Original_Operating_Mode : Operating_Mode_Type := Generate_Code;
    --  GNAT
    --  Indicates the original operating mode of the compiler as set by
@@ -1298,6 +1302,12 @@ package Opt is
    --  which have a record representation clause but this component does not
    --  have a component clause. The default is that this warning is disabled.
 
+   Warn_On_Warnings_Off : Boolean := False;
+   --  GNAT
+   --  Set to True to generate warnings for use of Pragma Warnings (Off, ent),
+   --  where either the pragma is never used, or it could be replaced by a
+   --  pragma Unmodified or Unreferenced.
+
    type Warning_Mode_Type is (Suppress, Normal, Treat_As_Error);
    Warning_Mode : Warning_Mode_Type := Normal;
    --  GNAT, GNATBIND
@@ -1338,8 +1348,8 @@ package Opt is
 
    --  These are settings that are used to establish the mode at the start of
    --  each unit. The values defined below can be affected either by command
-   --  line switches, or by the use of appropriate configuration pragmas in the
-   --  gnat.adc file.
+   --  line switches, or by the use of appropriate configuration pragmas in a
+   --  configuration pragma file.
 
    Ada_Version_Config : Ada_Version_Type;
    --  GNAT
@@ -1416,6 +1426,14 @@ package Opt is
    --  used to set the initial value of Fast_Math at the start of each new
    --  compilation unit.
 
+   Optimize_Alignment_Config : Character;
+   --  GNAT
+   --  This is the value of the configuration switch that controls the
+   --  alignment optimization mode, as set by an Optimize_Alignment pragma.
+   --  It is used to set the initial value of Optimize_Alignment at the start
+   --  of each new compilation unit, except that it is always set to 'O' (off)
+   --  for internal units.
+
    Persistent_BSS_Mode_Config : Boolean;
    --  GNAT
    --  This is the value of the configuration switch that controls whether
@@ -1553,6 +1571,7 @@ private
       External_Name_Exp_Casing       : External_Casing_Type;
       External_Name_Imp_Casing       : External_Casing_Type;
       Fast_Math                      : Boolean;
+      Optimize_Alignment             : Character;
       Persistent_BSS_Mode            : Boolean;
       Polling_Required               : Boolean;
       Use_VADS_Size                  : Boolean;

gcc/ada/par-prag.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2007, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2008, 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- --
@@ -43,8 +43,8 @@ with System.WCh_Con; use System.WCh_Con;
 separate (Par)
 
 function Prag (Pragma_Node : Node_Id; Semi : Source_Ptr) return Node_Id is
-   Pragma_Name : constant Name_Id    := Chars (Pragma_Node);
-   Prag_Id     : constant Pragma_Id  := Get_Pragma_Id (Pragma_Name);
+   Prag_Name   : constant Name_Id    := Pragma_Name (Pragma_Node);
+   Prag_Id     : constant Pragma_Id  := Get_Pragma_Id (Prag_Name);
    Pragma_Sloc : constant Source_Ptr := Sloc (Pragma_Node);
    Arg_Count   : Nat;
    Arg_Node    : Node_Id;
@@ -241,10 +241,10 @@ function Prag (Pragma_Node : Node_Id; Semi : Source_Ptr) return Node_Id is
       end loop;
    end Process_Restrictions_Or_Restriction_Warnings;
 
---  Start if processing for Prag
+--  Start of processing for Prag
 
 begin
-   Error_Msg_Name_1 := Pragma_Name;
+   Error_Msg_Name_1 := Prag_Name;
 
    --  Ignore unrecognized pragma. We let Sem post the warning for this, since
    --  it is a semantic error, not a syntactic one (we have already checked
@@ -626,7 +626,7 @@ begin
          --  Source_File_Name_Project pragmas.
 
          begin
-            if Get_Pragma_Id (Pragma_Name) = Pragma_Source_File_Name then
+            if Prag_Id = Pragma_Source_File_Name then
                if Project_File_In_Use = In_Use then
                   Error_Msg
                     ("pragma Source_File_Name cannot be used " &
@@ -1135,6 +1135,7 @@ begin
            Pragma_No_Strict_Aliasing            |
            Pragma_Normalize_Scalars             |
            Pragma_Optimize                      |
+           Pragma_Optimize_Alignment            |
            Pragma_Pack                          |
            Pragma_Passive                       |
            Pragma_Preelaborable_Initialization  |

gcc/ada/sem_prag.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2007, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2008, 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- --
@@ -75,6 +75,7 @@ with Targparm; use Targparm;
 with Tbuild;   use Tbuild;
 with Ttypes;
 with Uintp;    use Uintp;
+with Uname;    use Uname;
 with Urealp;   use Urealp;
 with Validsw;  use Validsw;
 
@@ -235,6 +236,7 @@ package body Sem_Prag is
 
    procedure Analyze_Pragma (N : Node_Id) is
       Loc     : constant Source_Ptr := Sloc (N);
+      Pname   : constant Name_Id    := Pragma_Name (N);
       Prag_Id : Pragma_Id;
 
       Pragma_Exit : exception;
@@ -502,7 +504,7 @@ package body Sem_Prag is
 
       function Is_Configuration_Pragma return Boolean;
       --  Deterermines if the placement of the current pragma is appropriate
-      --  for a configuration pragma (precedes the current compilation unit).
+      --  for a configuration pragma.
 
       function Is_In_Context_Clause return Boolean;
       --  Returns True if pragma appears within the context clause of a unit,
@@ -715,7 +717,7 @@ package body Sem_Prag is
             --  Here we have a real error (non-static expression)
 
             else
-               Error_Msg_Name_1 := Chars (N);
+               Error_Msg_Name_1 := Pname;
                Flag_Non_Static_Expr
                  ("argument for pragma% must be a identifier or " &
                   "static string expression!", Argx);
@@ -909,7 +911,7 @@ package body Sem_Prag is
          --  Finally, we have a real error
 
          else
-            Error_Msg_Name_1 := Chars (N);
+            Error_Msg_Name_1 := Pname;
             Flag_Non_Static_Expr
               ("argument for pragma% must be a static expression!", Argx);
             raise Pragma_Exit;
@@ -962,7 +964,7 @@ package body Sem_Prag is
                for K in Names'Range loop
                   if Chars (Arg) = Names (K) then
                      if K < Highest_So_Far then
-                        Error_Msg_Name_1 := Chars (N);
+                        Error_Msg_Name_1 := Pname;
                         Error_Msg_N
                           ("parameters out of order for pragma%", Arg);
                         Error_Msg_Name_1 := Names (K);
@@ -1112,7 +1114,7 @@ package body Sem_Prag is
          elsif Present (Parameter_Specifications (Specification (P)))
            or else not Is_Compilation_Unit (Defining_Entity (P))
          then
-            Error_Msg_Name_1 := Chars (N);
+            Error_Msg_Name_1 := Pname;
             Error_Msg_N
               ("?pragma% is only effective in main program", N);
          end if;
@@ -1239,7 +1241,7 @@ package body Sem_Prag is
       begin
          if Present (Arg) and then Chars (Arg) /= No_Name then
             if Chars (Arg) /= Id then
-               Error_Msg_Name_1 := Chars (N);
+               Error_Msg_Name_1 := Pname;
                Error_Msg_Name_2 := Id;
                Error_Msg_N ("pragma% argument expects identifier%", Arg);
                raise Pragma_Exit;
@@ -1319,9 +1321,9 @@ package body Sem_Prag is
       -- Check_Valid_Configuration_Pragma --
       --------------------------------------
 
-      --  A configuration pragma must appear in the context clause of
-      --  a compilation unit, at the start of the list (i.e. only other
-      --  pragmas may precede it).
+      --  A configuration pragma must appear in the context clause of a
+      --  compilation unit, and only other pragmas may preceed it. Note that
+      --  the test also allows use in a configuration pragma file.
 
       procedure Check_Valid_Configuration_Pragma is
       begin
@@ -1500,7 +1502,7 @@ package body Sem_Prag is
 
       procedure Error_Pragma (Msg : String) is
       begin
-         Error_Msg_Name_1 := Chars (N);
+         Error_Msg_Name_1 := Pname;
          Error_Msg_N (Msg, N);
          raise Pragma_Exit;
       end Error_Pragma;
@@ -1511,14 +1513,14 @@ package body Sem_Prag is
 
       procedure Error_Pragma_Arg (Msg : String; Arg : Node_Id) is
       begin
-         Error_Msg_Name_1 := Chars (N);
+         Error_Msg_Name_1 := Pname;
          Error_Msg_N (Msg, Get_Pragma_Arg (Arg));
          raise Pragma_Exit;
       end Error_Pragma_Arg;
 
       procedure Error_Pragma_Arg (Msg1, Msg2 : String; Arg : Node_Id) is
       begin
-         Error_Msg_Name_1 := Chars (N);
+         Error_Msg_Name_1 := Pname;
          Error_Msg_N (Msg1, Get_Pragma_Arg (Arg));
          Error_Pragma_Arg (Msg2, Arg);
       end Error_Pragma_Arg;
@@ -1529,7 +1531,7 @@ package body Sem_Prag is
 
       procedure Error_Pragma_Arg_Ident (Msg : String; Arg : Node_Id) is
       begin
-         Error_Msg_Name_1 := Chars (N);
+         Error_Msg_Name_1 := Pname;
          Error_Msg_N (Msg, Arg);
          raise Pragma_Exit;
       end Error_Pragma_Arg_Ident;
@@ -1717,7 +1719,7 @@ package body Sem_Prag is
                   end if;
 
                   if Index = Names'Last then
-                     Error_Msg_Name_1 := Chars (N);
+                     Error_Msg_Name_1 := Pname;
                      Error_Msg_N ("pragma% does not allow & argument", Arg);
 
                      --  Check for possible misspelling
@@ -1792,9 +1794,9 @@ package body Sem_Prag is
       -- Is_Configuration_Pragma --
       -----------------------------
 
-      --  A configuration pragma must appear in the context clause of
-      --  a compilation unit, at the start of the list (i.e. only other
-      --  pragmas may precede it).
+      --  A configuration pragma must appear in the context clause of a
+      --  compilation unit, and only other pragmas may precede it. Note that
+      --  the test below also permits use in a configuration pragma file.
 
       function Is_Configuration_Pragma return Boolean is
          Lis : constant List_Id := List_Containing (N);
@@ -2029,15 +2031,27 @@ package body Sem_Prag is
                   Ptr   : Nat;
                   CC    : Char_Code;
                   C     : Character;
+                  Cent  : constant Entity_Id :=
+                            Cunit_Entity (Current_Sem_Unit);
+
+                  Force : constant Boolean :=
+                            Prag_Id = Pragma_Compile_Time_Warning
+                              and then
+                                Is_Spec_Name (Unit_Name (Current_Sem_Unit))
+                              and then (Ekind (Cent) /= E_Package
+                                          or else not In_Private_Part (Cent));
+                  --  Set True if this is the warning case, and we are in the
+                  --  visible part of a package spec, or in a subprogram spec,
+                  --  in which case we want to force the client to see the
+                  --  warning, even though it is not in the main unit.
 
                begin
-                  Cont := False;
-                  Ptr := 1;
-
                   --  Loop through segments of message separated by line
                   --  feeds. We output these segments as separate messages
                   --  with continuation marks for all but the first.
 
+                  Cont := False;
+                  Ptr := 1;
                   loop
                      Error_Msg_Strlen := 0;
 
@@ -2063,11 +2077,33 @@ package body Sem_Prag is
 
                      Error_Msg_Warn := Prag_Id = Pragma_Compile_Time_Warning;
 
-                     if Cont = False then
-                        Error_Msg_N ("<~", Arg1);
-                        Cont := True;
+                     --  If this is a warning in a spec, then we want clients
+                     --  to see the warning, so mark the message with the
+                     --  special sequence !! to force the warning. In the case
+                     --  of a package spec, we do not force this if we are in
+                     --  the private part of the spec.
+
+                     if Force then
+                        if Cont = False then
+                           Error_Msg_N ("<~!!", Arg1);
+                           Cont := True;
+                        else
+                           Error_Msg_N ("\<~!!", Arg1);
+                        end if;
+
+                     --  Error, rather than warning, or in a body, so we do not
+                     --  need to force visibility for client (error will be
+                     --  output in any case, and this is the situation in which
+                     --  we do not want a client to get a warning, since the
+                     --  warning is in the body or the spec private part.
+
                      else
-                        Error_Msg_N ("\<~", Arg1);
+                        if Cont = False then
+                           Error_Msg_N ("<~", Arg1);
+                           Cont := True;
+                        else
+                           Error_Msg_N ("\<~", Arg1);
+                        end if;
                      end if;
 
                      exit when Ptr > Len;
@@ -2253,7 +2289,7 @@ package body Sem_Prag is
               or else
             Ekind (E) = E_Named_Real
          then
-            Error_Msg_Name_1 := Chars (N);
+            Error_Msg_Name_1 := Pname;
             Error_Msg_N
               ("cannot apply pragma% to named constant!",
                Get_Pragma_Arg (Arg2));
@@ -2713,8 +2749,9 @@ package body Sem_Prag is
 
                elsif Etype (Def_Id) /= Standard_Void_Type
                  and then
-                   (Chars (N) = Name_Export_Procedure
-                      or else Chars (N) = Name_Import_Procedure)
+                   (Pname = Name_Export_Procedure
+                      or else
+                    Pname = Name_Import_Procedure)
                then
                   Match := False;
 
@@ -2792,7 +2829,7 @@ package body Sem_Prag is
                   else
                      if not Ambiguous then
                         Ambiguous := True;
-                        Error_Msg_Name_1 := Chars (N);
+                        Error_Msg_Name_1 := Pname;
                         Error_Msg_N
                           ("pragma% does not uniquely identify subprogram!",
                            N);
@@ -4289,7 +4326,7 @@ package body Sem_Prag is
                Error_Msg_NE ("entity& was previously imported", N, E);
             end if;
 
-            Error_Msg_Name_1 := Chars (N);
+            Error_Msg_Name_1 := Pname;
             Error_Msg_N
               ("\(pragma% applies to all previous entities)", N);
 
@@ -4525,13 +4562,13 @@ package body Sem_Prag is
    begin
       --  Deal with unrecognized pragma
 
-      if not Is_Pragma_Name (Chars (N)) then
+      if not Is_Pragma_Name (Pname) then
          if Warn_On_Unrecognized_Pragma then
-            Error_Msg_Name_1 := Chars (N);
+            Error_Msg_Name_1 := Pname;
             Error_Msg_N ("?unrecognized pragma%!", Pragma_Identifier (N));
 
             for PN in First_Pragma_Name .. Last_Pragma_Name loop
-               if Is_Bad_Spelling_Of (Chars (N), PN) then
+               if Is_Bad_Spelling_Of (Pname, PN) then
                   Error_Msg_Name_1 := PN;
                   Error_Msg_N
                     ("\?possible misspelling of %!", Pragma_Identifier (N));
@@ -4545,7 +4582,7 @@ package body Sem_Prag is
 
       --  Here to start processing for recognized pragma
 
-      Prag_Id := Get_Pragma_Id (Chars (N));
+      Prag_Id := Get_Pragma_Id (Pname);
 
       --  Preset arguments
 
@@ -6647,7 +6684,7 @@ package body Sem_Prag is
             --  If it's an access-to-subprogram type (in particular, not a
             --  subtype), set the flag on that type.
 
-            if Ekind (Named_Entity) in Access_Subprogram_Type_Kind then
+            if Is_Access_Subprogram_Type (Named_Entity) then
                Set_Can_Use_Internal_Rep (Named_Entity, False);
 
             --  Otherwise it's an error (name denotes the wrong sort of entity)
@@ -7419,7 +7456,8 @@ package body Sem_Prag is
                   if Is_Imported (Def_Id)
                     and then Present (First_Rep_Item (Def_Id))
                     and then Nkind (First_Rep_Item (Def_Id)) = N_Pragma
-                    and then Chars (First_Rep_Item (Def_Id)) = Name_Interface
+                    and then
+                      Pragma_Name (First_Rep_Item (Def_Id)) = Name_Interface
                   then
                      null;
                   else
@@ -8251,9 +8289,9 @@ package body Sem_Prag is
             Nod := Next (N);
             while Present (Nod) loop
                if Nkind (Nod) = N_Pragma
-                 and then Chars (Nod) = Name_Main
+                 and then Pragma_Name (Nod) = Name_Main
                then
-                  Error_Msg_Name_1 := Chars (N);
+                  Error_Msg_Name_1 := Pname;
                   Error_Msg_N ("duplicate pragma% not permitted", Nod);
                end if;
 
@@ -8295,9 +8333,9 @@ package body Sem_Prag is
             Nod := Next (N);
             while Present (Nod) loop
                if Nkind (Nod) = N_Pragma
-                 and then Chars (Nod) = Name_Main_Storage
+                 and then Pragma_Name (Nod) = Name_Main_Storage
                then
-                  Error_Msg_Name_1 := Chars (N);
+                  Error_Msg_Name_1 := Pname;
                   Error_Msg_N ("duplicate pragma% not permitted", Nod);
                end if;
 
@@ -8684,7 +8722,7 @@ package body Sem_Prag is
          -- Optimize --
          --------------
 
-         --  pragma Optimize (Time | Space);
+         --  pragma Optimize (Time | Space | Off);
 
          --  The actual check for optimize is done in Gigi. Note that this
          --  pragma does not actually change the optimization setting, it
@@ -8695,6 +8733,33 @@ package body Sem_Prag is
             Check_Arg_Count (1);
             Check_Arg_Is_One_Of (Arg1, Name_Time, Name_Space, Name_Off);
 
+         ------------------------
+         -- Optimize_Alignment --
+         ------------------------
+
+         --  pragma Optimize_Alignment (Time | Space | Off);
+
+         when Pragma_Optimize_Alignment =>
+            GNAT_Pragma;
+            Check_No_Identifiers;
+            Check_Arg_Count (1);
+            Check_Valid_Configuration_Pragma;
+
+            declare
+               Nam : constant Name_Id := Chars (Get_Pragma_Arg (Arg1));
+            begin
+               case Nam is
+                  when Name_Time =>
+                     Opt.Optimize_Alignment := 'T';
+                  when Name_Space =>
+                     Opt.Optimize_Alignment := 'S';
+                  when Name_Off =>
+                     Opt.Optimize_Alignment := 'O';
+                  when others =>
+                     Error_Pragma_Arg ("invalid argument for pragma%", Arg1);
+               end case;
+            end;
+
          ----------
          -- Pack --
          ----------
@@ -10508,9 +10573,9 @@ package body Sem_Prag is
                Nod := Next (N);
                while Present (Nod) loop
                   if Nkind (Nod) = N_Pragma
-                    and then Chars (Nod) = Name_Time_Slice
+                    and then Pragma_Name (Nod) = Name_Time_Slice
                   then
-                     Error_Msg_Name_1 := Chars (N);
+                     Error_Msg_Name_1 := Pname;
                      Error_Msg_N ("duplicate pragma% not permitted", Nod);
                   end if;
 
@@ -11165,6 +11230,12 @@ package body Sem_Prag is
                               Set_Warnings_Off
                                 (E, (Chars (Expression (Arg1)) = Name_Off));
 
+                              if Chars (Expression (Arg1)) = Name_Off
+                                and then Warn_On_Warnings_Off
+                              then
+                                 Warnings_Off_Pragmas.Append ((N, E));
+                              end if;
+
                               if Is_Enumeration_Type (E) then
                                  declare
                                     Lit : Entity_Id;
@@ -11296,9 +11367,9 @@ package body Sem_Prag is
 
    function Delay_Config_Pragma_Analyze (N : Node_Id) return Boolean is
    begin
-      return Chars (N) = Name_Interrupt_State
+      return Pragma_Name (N) = Name_Interrupt_State
                or else
-             Chars (N) = Name_Priority_Specific_Dispatching;
+             Pragma_Name (N) = Name_Priority_Specific_Dispatching;
    end Delay_Config_Pragma_Analyze;
 
    -------------------------
@@ -11496,6 +11567,7 @@ package body Sem_Prag is
       Pragma_Normalize_Scalars             => -1,
       Pragma_Obsolescent                   =>  0,
       Pragma_Optimize                      => -1,
+      Pragma_Optimize_Alignment            => -1,
       Pragma_Pack                          =>  0,
       Pragma_Page                          => -1,
       Pragma_Passive                       => -1,
@@ -11575,7 +11647,7 @@ package body Sem_Prag is
          return False;
 
       else
-         C := Sig_Flags (Get_Pragma_Id (Chars (Parent (P))));
+         C := Sig_Flags (Get_Pragma_Id (Parent (P)));
 
          case C is
             when -1 =>
@@ -11612,7 +11684,7 @@ package body Sem_Prag is
    function Is_Pragma_String_Literal (Par : Node_Id) return Boolean is
       Pragn : constant Node_Id := Parent (Par);
       Assoc : constant List_Id := Pragma_Argument_Associations (Pragn);
-      Pname : constant Name_Id := Chars (Pragn);
+      Pname : constant Name_Id := Pragma_Name (Pragn);
       Argn  : Natural;
       N     : Node_Id;
 
@@ -11686,7 +11758,7 @@ package body Sem_Prag is
          if Present (PA) then
             P := First (PA);
             while Present (P) loop
-               if Chars (P) = Name_Suppress_All then
+               if Pragma_Name (P) = Name_Suppress_All then
                   Prepend_To (Context_Items (N),
                     Make_Pragma (Sloc (P),
                       Chars => Name_Suppress,