[multiple changes]

2012-07-16  Thomas Quinot  <quinot@adacore.com>

	* freeze.adb (Check_Component_Storage_Order): Do not reject a
	nested composite with different scalar storage order if it is
	byte aligned.

2012-07-16  Thomas Quinot  <quinot@adacore.com>

	* gnat_rm.texi: Update documentation for Scalar_Storage_Order.

2012-07-16  Tristan Gingold  <gingold@adacore.com>

	* a-exexpr.adb (Propagate_Exception): Adjust call to
	Exception_Traces procedures.
	* a-exexpr-gcc.adb (Setup_Current_Excep): Now a
	function that returns an access to the Ada occurrence.
	(Propagate_GCC_Exception): Adjust calls.
	* raise.h (struct Exception_Occurrence): Declare.
	* a-exextr.adb: Remove useless pragma.	(Notify_Handled_Exception,
	Notify_Unhandled_Exception) (Unhandled_Exception_Terminate):
	Add Excep parameter.
	* a-except.adb (Notify_Handled_Exception,
	Notify_Unhandled_Exception) (Unhandled_Exception_Terminate):
	Add Excep parameter.
	(Process_Raise_Exception): Adjust calls.
	* a-except-2005.adb (Notify_Handled_Exception,
	Notify_Unhandled_Exception) (Unhandled_Exception_Terminate): Add
	Excep parameter.
	(Raise_Exception): Calls Raise_Exception_Always.
	* raise-gcc.c (__gnat_setup_current_excep,
	__gnat_notify_handled_exception)
	(__gnat_notify_unhandled_exception): Adjust declarations.
	(PERSONALITY_FUNCTION): Adjust calls.
	(__gnat_personality_seh0): Remove warning.

2012-07-16  Javier Miranda  <miranda@adacore.com>

	* sem_eval.adb (Test_Expression_Is_Foldable): Adding documentation.
	(Eval_Relational_Op): Adding documentation.

From-SVN: r189532

gcc/ada/ChangeLog

+2012-07-16  Thomas Quinot  <quinot@adacore.com>
+
+	* freeze.adb (Check_Component_Storage_Order): Do not reject a
+	nested composite with different scalar storage order if it is
+	byte aligned.
+
+2012-07-16  Thomas Quinot  <quinot@adacore.com>
+
+	* gnat_rm.texi: Update documentation for Scalar_Storage_Order.
+
+2012-07-16  Tristan Gingold  <gingold@adacore.com>
+
+	* a-exexpr.adb (Propagate_Exception): Adjust call to
+	Exception_Traces procedures.
+	* a-exexpr-gcc.adb (Setup_Current_Excep): Now a
+	function that returns an access to the Ada occurrence.
+	(Propagate_GCC_Exception): Adjust calls.
+	* raise.h (struct Exception_Occurrence): Declare.
+	* a-exextr.adb: Remove useless pragma.	(Notify_Handled_Exception,
+	Notify_Unhandled_Exception) (Unhandled_Exception_Terminate):
+	Add Excep parameter.
+	* a-except.adb (Notify_Handled_Exception,
+	Notify_Unhandled_Exception) (Unhandled_Exception_Terminate):
+	Add Excep parameter.
+	(Process_Raise_Exception): Adjust calls.
+	* a-except-2005.adb (Notify_Handled_Exception,
+	Notify_Unhandled_Exception) (Unhandled_Exception_Terminate): Add
+	Excep parameter.
+	(Raise_Exception): Calls Raise_Exception_Always.
+	* raise-gcc.c (__gnat_setup_current_excep,
+	__gnat_notify_handled_exception)
+	(__gnat_notify_unhandled_exception): Adjust declarations.
+	(PERSONALITY_FUNCTION): Adjust calls.
+	(__gnat_personality_seh0): Remove warning.
+
+2012-07-16  Javier Miranda  <miranda@adacore.com>
+
+	* sem_eval.adb (Test_Expression_Is_Foldable): Adding documentation.
+	(Eval_Relational_Op): Adding documentation.
+
 2012-07-16  Robert Dewar  <dewar@adacore.com>
 
 	* freeze.adb, g-debpoo.adb, exp_ch3.adb: Minor reformatting.

gcc/ada/a-except-2005.adb

@@ -209,19 +209,19 @@ package body Ada.Exceptions is
       --  exported to be usable by the Ada exception handling personality
       --  routine when the GCC 3 mechanism is used.
 
-      procedure Notify_Handled_Exception;
+      procedure Notify_Handled_Exception (Excep : EOA);
       pragma Export
         (C, Notify_Handled_Exception, "__gnat_notify_handled_exception");
       --  This routine is called for a handled occurrence is about to be
       --  propagated.
 
-      procedure Notify_Unhandled_Exception;
+      procedure Notify_Unhandled_Exception (Excep : EOA);
       pragma Export
         (C, Notify_Unhandled_Exception, "__gnat_notify_unhandled_exception");
       --  This routine is called when an unhandled occurrence is about to be
       --  propagated.
 
-      procedure Unhandled_Exception_Terminate;
+      procedure Unhandled_Exception_Terminate (Excep : EOA);
       pragma No_Return (Unhandled_Exception_Terminate);
       --  This procedure is called to terminate execution following an
       --  unhandled exception. The exception information, including
@@ -395,15 +395,16 @@ package body Ada.Exceptions is
    --  Reraises the exception referenced by the Current_Excep field of
    --  the TSD (all fields of this exception occurrence are set). Abort
    --  is deferred before the reraise operation.
+   --  Called from System.Tasking.RendezVous.Exceptional_Complete_RendezVous
 
    procedure Transfer_Occurrence
      (Target : Exception_Occurrence_Access;
       Source : Exception_Occurrence);
    pragma Export (C, Transfer_Occurrence, "__gnat_transfer_occurrence");
-   --  Called from System.Tasking.RendezVous.Exceptional_Complete_RendezVous
-   --  to setup Target from Source as an exception to be propagated in the
-   --  caller task. Target is expected to be a pointer to the fixed TSD
-   --  occurrence for this task.
+   --  Called from s-tasren.adb:Local_Complete_RendezVous and
+   --  s-tpobop.adb:Exceptional_Complete_Entry_Body to setup Target from
+   --  Source as an exception to be propagated in the caller task. Target is
+   --  expected to be a pointer to the fixed TSD occurrence for this task.
 
    -----------------------------
    -- Run-Time Check Routines --
@@ -953,8 +954,6 @@ package body Ada.Exceptions is
       Message : String := "")
    is
       EF : Exception_Id := E;
-      X : constant EOA := Exception_Propagation.Allocate_Occurrence;
-
    begin
       --  Raise CE if E = Null_ID (AI-446)
 
@@ -964,14 +963,7 @@ package body Ada.Exceptions is
 
       --  Go ahead and raise appropriate exception
 
-      Exception_Data.Set_Exception_Msg (X, EF, Message);
-
-      if not ZCX_By_Default then
-         Abort_Defer.all;
-      end if;
-
-      Complete_Occurrence (X);
-      Exception_Propagation.Propagate_Exception (X);
+      Raise_Exception_Always (EF, Message);
    end Raise_Exception;
 
    ----------------------------

gcc/ada/a-except.adb

@@ -189,19 +189,19 @@ package body Ada.Exceptions is
       --  exported to be usable by the Ada exception handling personality
       --  routine when the GCC 3 mechanism is used.
 
-      procedure Notify_Handled_Exception;
+      procedure Notify_Handled_Exception (Excep : EOA);
       pragma Export
         (C, Notify_Handled_Exception, "__gnat_notify_handled_exception");
       --  This routine is called for a handled occurrence is about to be
       --  propagated.
 
-      procedure Notify_Unhandled_Exception;
+      procedure Notify_Unhandled_Exception (Excep : EOA);
       pragma Export
         (C, Notify_Unhandled_Exception, "__gnat_notify_unhandled_exception");
       --  This routine is called when an unhandled occurrence is about to be
       --  propagated.
 
-      procedure Unhandled_Exception_Terminate;
+      procedure Unhandled_Exception_Terminate (Excep : EOA);
       pragma No_Return (Unhandled_Exception_Terminate);
       --  This procedure is called to terminate program execution following an
       --  unhandled exception. The exception information, including traceback
@@ -895,14 +895,14 @@ package body Ada.Exceptions is
       if Jumpbuf_Ptr /= Null_Address then
          if not Excep.Exception_Raised then
             Excep.Exception_Raised := True;
-            Exception_Traces.Notify_Handled_Exception;
+            Exception_Traces.Notify_Handled_Exception (Excep);
          end if;
 
          builtin_longjmp (Jumpbuf_Ptr, 1);
 
       else
-         Exception_Traces.Notify_Unhandled_Exception;
-         Exception_Traces.Unhandled_Exception_Terminate;
+         Exception_Traces.Notify_Unhandled_Exception (Excep);
+         Exception_Traces.Unhandled_Exception_Terminate (Excep);
       end if;
    end Process_Raise_Exception;
 

gcc/ada/a-exexpr-gcc.adb

@@ -202,8 +202,9 @@ package body Exception_Propagation is
    --  Called to implement raise without exception, ie reraise.  Called
    --  directly from gigi.
 
-   procedure Setup_Current_Excep
-     (GCC_Exception : not null GCC_Exception_Access);
+   function Setup_Current_Excep
+     (GCC_Exception : not null GCC_Exception_Access)
+     return EOA;
    pragma Export (C, Setup_Current_Excep, "__gnat_setup_current_excep");
    --  Write Get_Current_Excep.all from GCC_Exception
 
@@ -342,8 +343,9 @@ package body Exception_Propagation is
    -- Setup_Current_Excep --
    -------------------------
 
-   procedure Setup_Current_Excep
+   function Setup_Current_Excep
      (GCC_Exception : not null GCC_Exception_Access)
+     return EOA
    is
       Excep : constant EOA := Get_Current_Excep.all;
 
@@ -359,6 +361,8 @@ package body Exception_Propagation is
                                 To_GNAT_GCC_Exception (GCC_Exception);
          begin
             Excep.all := GNAT_Occurrence.Occurrence;
+
+            return GNAT_Occurrence.Occurrence'Access;
          end;
       else
 
@@ -370,6 +374,8 @@ package body Exception_Propagation is
          Excep.Exception_Raised := True;
          Excep.Pid := Local_Partition_ID;
          Excep.Num_Tracebacks := 0;
+
+         return Excep;
       end if;
    end Setup_Current_Excep;
 
@@ -420,6 +426,7 @@ package body Exception_Propagation is
    procedure Propagate_GCC_Exception
      (GCC_Exception : not null GCC_Exception_Access)
    is
+      Excep : EOA;
    begin
       --  Perform a standard raise first. If a regular handler is found, it
       --  will be entered after all the intermediate cleanups have run. If
@@ -432,8 +439,8 @@ package body Exception_Propagation is
       --  the necessary steps to enable the debugger to gain control while the
       --  stack is still intact.
 
-      Setup_Current_Excep (GCC_Exception);
-      Notify_Unhandled_Exception;
+      Excep := Setup_Current_Excep (GCC_Exception);
+      Notify_Unhandled_Exception (Excep);
 
       --  Now, un a forced unwind to trigger cleanups. Control should not
       --  resume there, if there are cleanups and in any cases as the
@@ -466,9 +473,10 @@ package body Exception_Propagation is
    procedure Unhandled_Except_Handler
      (GCC_Exception : not null GCC_Exception_Access)
    is
+      Excep : EOA;
    begin
-      Setup_Current_Excep (GCC_Exception);
-      Unhandled_Exception_Terminate;
+      Excep := Setup_Current_Excep (GCC_Exception);
+      Unhandled_Exception_Terminate (Excep);
    end Unhandled_Except_Handler;
 
    -------------

gcc/ada/a-exexpr.adb

@@ -43,7 +43,7 @@ package body Exception_Propagation is
    pragma No_Return (builtin_longjmp);
    pragma Import (Intrinsic, builtin_longjmp, "__builtin_longjmp");
 
-   procedure Propagate_Continue (Excep : EOA);
+   procedure Propagate_Continue (E : Exception_Id);
    pragma No_Return (Propagate_Continue);
    pragma Export (C, Propagate_Continue, "__gnat_raise_nodefer_with_msg");
    --  A call to this procedure is inserted automatically by GIGI, in order
@@ -74,14 +74,14 @@ package body Exception_Propagation is
       if Jumpbuf_Ptr /= Null_Address then
          if not Excep.Exception_Raised then
             Excep.Exception_Raised := True;
-            Exception_Traces.Notify_Handled_Exception;
+            Exception_Traces.Notify_Handled_Exception (Excep);
          end if;
 
          builtin_longjmp (Jumpbuf_Ptr, 1);
 
       else
-         Exception_Traces.Notify_Unhandled_Exception;
-         Exception_Traces.Unhandled_Exception_Terminate;
+         Exception_Traces.Notify_Unhandled_Exception (Excep);
+         Exception_Traces.Unhandled_Exception_Terminate (Excep);
       end if;
    end Propagate_Exception;
 
@@ -89,9 +89,10 @@ package body Exception_Propagation is
    -- Propagate_Continue --
    ------------------------
 
-   procedure Propagate_Continue (Excep : EOA) is
+   procedure Propagate_Continue (E : Exception_Id) is
+      pragma Unreferenced (E);
    begin
-      Propagate_Exception (Excep);
+      Propagate_Exception (Get_Current_Excep.all);
    end Propagate_Continue;
 
 end Exception_Propagation;

gcc/ada/a-exextr.adb

@@ -72,17 +72,6 @@ package body Exception_Traces is
    --  latter case because Notify_Handled_Exception may be called for an
    --  actually unhandled occurrence in the Front-End-SJLJ case.
 
-   --------------------------------
-   -- Import Run-Time C Routines --
-   --------------------------------
-
-   --  The purpose of the following pragma Import is to ensure that we
-   --  generate appropriate subprogram descriptors for all C routines in
-   --  the standard GNAT library that can raise exceptions. This ensures
-   --  that the exception propagation can properly find these routines
-
-   pragma Propagate_Exceptions;
-
    ----------------------
    -- Notify_Exception --
    ----------------------
@@ -132,18 +121,16 @@ package body Exception_Traces is
    -- Notify_Handled_Exception --
    ------------------------------
 
-   procedure Notify_Handled_Exception is
+   procedure Notify_Handled_Exception (Excep : EOA) is
    begin
-      Notify_Exception (Get_Current_Excep.all, Is_Unhandled => False);
+      Notify_Exception (Excep, Is_Unhandled => False);
    end Notify_Handled_Exception;
 
    --------------------------------
    -- Notify_Unhandled_Exception --
    --------------------------------
 
-   procedure Notify_Unhandled_Exception is
-      Excep : constant EOA := Get_Current_Excep.all;
-
+   procedure Notify_Unhandled_Exception (Excep : EOA) is
    begin
       --  Check whether there is any termination handler to be executed for
       --  the environment task, and execute it if needed. Here we handle both
@@ -161,8 +148,8 @@ package body Exception_Traces is
    -- Unhandled_Exception_Terminate --
    -----------------------------------
 
-   procedure Unhandled_Exception_Terminate is
-      Excep : Exception_Occurrence;
+   procedure Unhandled_Exception_Terminate (Excep : EOA) is
+      Occ : Exception_Occurrence;
       --  This occurrence will be used to display a message after finalization.
       --  It is necessary to save a copy here, or else the designated value
       --  could be overwritten if an exception is raised during finalization
@@ -172,8 +159,8 @@ package body Exception_Traces is
       --  that there is enough room on the stack however.
 
    begin
-      Save_Occurrence (Excep, Get_Current_Excep.all.all);
-      Last_Chance_Handler (Excep);
+      Save_Occurrence (Occ, Excep.all);
+      Last_Chance_Handler (Occ);
    end Unhandled_Exception_Terminate;
 
    ------------------------------------

gcc/ada/freeze.adb

@@ -1029,6 +1029,10 @@ package body Freeze is
       Err_Node  : Node_Id;
       ADC       : Node_Id;
 
+      Comp_Byte_Aligned : Boolean;
+      --  Set True for the record case, when Comp starts on a byte boundary
+      --  (in which case it is allowed to have different storage order).
+
    begin
       --  Record case
 
@@ -1037,6 +1041,9 @@ package body Freeze is
          Comp_Type := Etype (Comp);
          Comp_Def  := Component_Definition (Parent (Comp));
 
+         Comp_Byte_Aligned := Present (Component_Clause (Comp))
+           and then Normalized_First_Bit (Comp) mod System_Storage_Unit = 0;
+
       --  Array case
 
       else
@@ -1044,6 +1051,8 @@ package body Freeze is
          Comp_Type := Component_Type (Encl_Type);
          Comp_Def  := Component_Definition
                         (Type_Definition (Declaration_Node (Encl_Type)));
+
+         Comp_Byte_Aligned := False;
       end if;
 
       --  Note: the Reverse_Storage_Order flag is set on the base type, but
@@ -1054,14 +1063,20 @@ package body Freeze is
                (First_Subtype (Comp_Type),
                 Attribute_Scalar_Storage_Order);
 
-      if (Is_Record_Type (Comp_Type) or else Is_Array_Type (Comp_Type))
-           and then
-             (No (ADC) or else Reverse_Storage_Order (Encl_Type) /=
-                               Reverse_Storage_Order (Etype (Comp_Type)))
-      then
-         Error_Msg_N
-           ("component type must have same scalar storage order as "
-            & "enclosing composite", Err_Node);
+      if Is_Record_Type (Comp_Type) or else Is_Array_Type (Comp_Type) then
+         if No (ADC) then
+            Error_Msg_N ("nested composite must have explicit scalar "
+                         & "storage order", Err_Node);
+
+         elsif (Reverse_Storage_Order (Encl_Type)
+                  /=
+                Reverse_Storage_Order (Etype (Comp_Type)))
+           and then not Comp_Byte_Aligned
+         then
+            Error_Msg_N
+              ("type of non-byte-aligned component must have same scalar "
+               & "storage order as enclosing composite", Err_Node);
+         end if;
 
       elsif Aliased_Present (Comp_Def) then
          Error_Msg_N

gcc/ada/gnat_rm.texi

@@ -6709,7 +6709,7 @@ this attribute.
 @cindex Scalar storage order
 @findex Scalar_Storage_Order
 @noindent
-For every record subtype @var{S}, the representation attribute
+For every array or record type @var{S}, the representation attribute
 @code{Scalar_Storage_Order} denotes the order in which storage elements
 that make up scalar components are ordered within S. Other properties are
 as for standard representation attribute @code{Bit_Order}, as defined by
@@ -6721,6 +6721,11 @@ equal to @code{@var{S}'Bit_Order}. Note: This means that if a
 then the type's @code{Bit_Order} shall be specified explicitly and set to
 the same value.
 
+If a component of S has itself a record or array type, then it shall also
+have a @code{Scalar_Storage_Order} attribute definition clause. In addition,
+if the component does not start on a byte boundary, then the scalar storage
+order specified for S and for the nested component type shall be identical.
+
 A confirming @code{Scalar_Storage_Order} attribute definition clause (i.e.
 with a value equal to @code{System.Default_Bit_Order}) has no effect.
 

gcc/ada/raise-gcc.c

@@ -77,7 +77,8 @@ __gnat_Unwind_RaiseException (_Unwind_Exception *);
 _Unwind_Reason_Code
 __gnat_Unwind_ForcedUnwind (_Unwind_Exception *, void *, void *);
 
-extern void __gnat_setup_current_excep (_Unwind_Exception *);
+extern struct Exception_Occurrence *__gnat_setup_current_excep
+ (_Unwind_Exception *);
 extern void __gnat_unhandled_except_handler (_Unwind_Exception *);
 
 #include "dwarf2.h"
@@ -1001,8 +1002,8 @@ setup_to_install (_Unwind_Context *uw_context,
 /* The following is defined from a-except.adb. Its purpose is to enable
    automatic backtraces upon exception raise, as provided through the
    GNAT.Traceback facilities.  */
-extern void __gnat_notify_handled_exception (void);
-extern void __gnat_notify_unhandled_exception (void);
+extern void __gnat_notify_handled_exception (struct Exception_Occurrence *);
+extern void __gnat_notify_unhandled_exception (struct Exception_Occurrence *);
 
 /* Below is the eh personality routine per se. We currently assume that only
    GNU-Ada exceptions are met.  */
@@ -1131,14 +1132,16 @@ PERSONALITY_FUNCTION (version_arg_t version_arg,
 	}
       else
 	{
+	  struct Exception_Occurrence *excep;
+
 	  /* Trigger the appropriate notification routines before the second
 	     phase starts, which ensures the stack is still intact.
              First, setup the Ada occurrence.  */
-          __gnat_setup_current_excep (uw_exception);
+          excep = __gnat_setup_current_excep (uw_exception);
 	  if (action.kind == unhandler)
-	    __gnat_notify_unhandled_exception ();
+	    __gnat_notify_unhandled_exception (excep);
 	  else
-	    __gnat_notify_handled_exception ();
+	    __gnat_notify_handled_exception (excep);
 
 	  return _URC_HANDLER_FOUND;
 	}
@@ -1324,7 +1327,7 @@ __gnat_personality_seh0 (PEXCEPTION_RECORD ms_exc, void *this_frame,
 	  CONTEXT context;
 	  PRUNTIME_FUNCTION mf_func = NULL;
 	  ULONG64 mf_imagebase;
-	  ULONG64 mf_rsp;
+	  ULONG64 mf_rsp = 0;
 
 	  /* Get the context.  */
 	  RtlCaptureContext (&context);

gcc/ada/raise.h

@@ -49,6 +49,8 @@ struct Exception_Data
 
 typedef struct Exception_Data *Exception_Id;
 
+struct Exception_Occurrence;
+
 extern void _gnat_builtin_longjmp	(void *, int);
 extern void __gnat_unhandled_terminate	(void);
 extern void *__gnat_malloc		(__SIZE_TYPE__);