2014-08-01 Thomas Quinot <quinot@adacore.com>

	* freeze.adb: Minor reformatting.

2014-08-01  Thomas Quinot  <quinot@adacore.com>

	* exp_ch3.adb (Default_Initialize_Object): Do not generate
	default initialization for an imported object.

2014-08-01  Olivier Hainque  <hainque@adacore.com>

	* seh_init.c (__gnat_map_SEH): Cast argument of IsBadCodePtr
	to the expected FARPROC type instead of void *.
	* adaint.c (f2t): Expect __time64_t * as second argument, in line with
	other datastructures.
	(__gnat_file_time_name_attr): Adjust accordingly.
	(__gnat_check_OWNER_ACL): Declare pSD as PSECURITY_DESCRIPTOR,
	in line with uses.
	(__gnat_check_OWNER_ACL): Declare AccessMode
	parameter as ACCESS_MODE instead of DWORD, in line with callers
	and uses.
	(__gnat_set_executable): Add ATTRIBUTE_UNUSED on mode,
	unused on win32.  Correct cast of "args" on call to spawnvp.
	(add_handle): Cast realloc calls into their destination types.
	(win32_wait): Remove declaration and initialization of unused variable.
	(__gnat_locate_exec_on_path): Cast alloca calls
	into their destination types.
	* initialize.c (append_arg, __gnat_initialize): Cast xmalloc calls into
	their destination types.

2014-08-01  Gary Dismukes  <dismukes@adacore.com>

	* exp_ch4.adb (Expand_N_Type_Conversion): Expand
	range checks for conversions between floating-point subtypes
	when the target and source types are the same.

2014-08-01  Robert Dewar  <dewar@adacore.com>

	* exp_aggr.adb: Minor reformatting.

2014-08-01  Eric Botcazou  <ebotcazou@adacore.com>

	* sem_ch13.adb (Check_Indexing_Functions): Initialize
	Indexing_Found.

2014-08-01  Arnaud Charlet  <charlet@adacore.com>

	* gnat1drv.adb (Gnat1drv): In gnatprove mode, we now write the
	ALI file before we call the backend (so that gnat2why can append
	to it).

2014-08-01  Thomas Quinot  <quinot@adacore.com>

	* exp_pakd.adb (Expand_Bit_Packed_Element_Set,
	Expand_Packed_Element_Reference): Pass additional Rev_SSO
	parameter indicating whether the packed array type has reverse
	scalar storage order to the s-pack* Set/Get routines.
	* s-pack*.ad* (Get, Set, GetU, SetU): New formal Rev_SSO
	indicating reverse scalar storage order.

2014-08-01  Robert Dewar  <dewar@adacore.com>

	* sem_ch3.adb (Check_Initialization): Set Do_Range_Check
	for initial component value in -gnatc or GNATprove mode.
	(Process_Discriminants): Same fix for default discriminant values.
	* sem_eval.adb (Test_In_Range): Improve accuracy of results by
	checking subtypes.

2014-08-01  Robert Dewar  <dewar@adacore.com>

	* sinfo.ads: Minor comment clarification.



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@213471 138bc75d-0d04-0410-961f-82ee72b054a4

1 files changed, 73 insertions, 28 deletions

diff --git a/gcc/ada/s-pack03.adb b/gcc/ada/s-pack03.adb
index 3d88c8e5535..b081dc27f8f 100644
--- a/gcc/ada/s-pack03.adb
+++ b/gcc/ada/s-pack03.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2009, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2014, 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- --
@@ -31,10 +31,13 @@
 
 with System.Storage_Elements;
 with System.Unsigned_Types;
-with Ada.Unchecked_Conversion;
 
 package body System.Pack_03 is
 
+   subtype Bit_Order is System.Bit_Order;
+   Reverse_Bit_Order : constant Bit_Order :=
+     Bit_Order'Val (1 - Bit_Order'Pos (System.Default_Bit_Order));
+
    subtype Ofs is System.Storage_Elements.Storage_Offset;
    subtype Uns is System.Unsigned_Types.Unsigned;
    subtype N07 is System.Unsigned_Types.Unsigned range 0 .. 7;
@@ -68,45 +71,87 @@ package body System.Pack_03 is
 
    type Cluster_Ref is access Cluster;
 
-   function To_Ref is new
-     Ada.Unchecked_Conversion (System.Address, Cluster_Ref);
+   type Rev_Cluster is new Cluster
+     with Bit_Order            => Reverse_Bit_Order,
+          Scalar_Storage_Order => Reverse_Bit_Order;
+   type Rev_Cluster_Ref is access Rev_Cluster;
 
    ------------
    -- Get_03 --
    ------------
 
-   function Get_03 (Arr : System.Address; N : Natural) return Bits_03 is
-      C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+   function Get_03
+     (Arr     : System.Address;
+      N       : Natural;
+      Rev_SSO : Boolean) return Bits_03
+   is
+      A  : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+      C  : Cluster_Ref     with Address => A'Address, Import;
+      RC : Rev_Cluster_Ref with Address => A'Address, Import;
    begin
-      case N07 (Uns (N) mod 8) is
-         when 0 => return C.E0;
-         when 1 => return C.E1;
-         when 2 => return C.E2;
-         when 3 => return C.E3;
-         when 4 => return C.E4;
-         when 5 => return C.E5;
-         when 6 => return C.E6;
-         when 7 => return C.E7;
-      end case;
+      if Rev_SSO then
+         case N07 (Uns (N) mod 8) is
+            when 0 => return RC.E0;
+            when 1 => return RC.E1;
+            when 2 => return RC.E2;
+            when 3 => return RC.E3;
+            when 4 => return RC.E4;
+            when 5 => return RC.E5;
+            when 6 => return RC.E6;
+            when 7 => return RC.E7;
+         end case;
+
+      else
+         case N07 (Uns (N) mod 8) is
+            when 0 => return C.E0;
+            when 1 => return C.E1;
+            when 2 => return C.E2;
+            when 3 => return C.E3;
+            when 4 => return C.E4;
+            when 5 => return C.E5;
+            when 6 => return C.E6;
+            when 7 => return C.E7;
+         end case;
+      end if;
    end Get_03;
 
    ------------
    -- Set_03 --
    ------------
 
-   procedure Set_03 (Arr : System.Address; N : Natural; E : Bits_03) is
-      C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
+   procedure Set_03
+     (Arr     : System.Address;
+      N       : Natural;
+      E       : Bits_03;
+      Rev_SSO : Boolean)
+   is
+      A  : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
+      C  : Cluster_Ref     with Address => A'Address, Import;
+      RC : Rev_Cluster_Ref with Address => A'Address, Import;
    begin
-      case N07 (Uns (N) mod 8) is
-         when 0 => C.E0 := E;
-         when 1 => C.E1 := E;
-         when 2 => C.E2 := E;
-         when 3 => C.E3 := E;
-         when 4 => C.E4 := E;
-         when 5 => C.E5 := E;
-         when 6 => C.E6 := E;
-         when 7 => C.E7 := E;
-      end case;
+      if Rev_SSO then
+         case N07 (Uns (N) mod 8) is
+            when 0 => RC.E0 := E;
+            when 1 => RC.E1 := E;
+            when 2 => RC.E2 := E;
+            when 3 => RC.E3 := E;
+            when 4 => RC.E4 := E;
+            when 5 => RC.E5 := E;
+            when 6 => RC.E6 := E;
+            when 7 => RC.E7 := E;
+         end case;
+      else
+         case N07 (Uns (N) mod 8) is
+            when 0 => C.E0 := E;
+            when 1 => C.E1 := E;
+            when 2 => C.E2 := E;
+            when 3 => C.E3 := E;
+            when 4 => C.E4 := E;
+            when 5 => C.E5 := E;
+            when 6 => C.E6 := E;
+            when 7 => C.E7 := E;
+         end case;
+      end if;
    end Set_03;
 
 end System.Pack_03;