From c8a2d80934f046e3803321a0cb1d20f6a59a1fc2 Mon Sep 17 00:00:00 2001 From: charlet Date: Fri, 1 Aug 2014 14:11:18 +0000 Subject: 2014-08-01 Thomas Quinot * freeze.adb: Minor reformatting. 2014-08-01 Thomas Quinot * exp_ch3.adb (Default_Initialize_Object): Do not generate default initialization for an imported object. 2014-08-01 Olivier Hainque * 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 * 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 * exp_aggr.adb: Minor reformatting. 2014-08-01 Eric Botcazou * sem_ch13.adb (Check_Indexing_Functions): Initialize Indexing_Found. 2014-08-01 Arnaud Charlet * 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 * 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 * 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 * sinfo.ads: Minor comment clarification. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@213471 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ada/s-pack03.adb | 101 +++++++++++++++++++++++++++++++++++++-------------- 1 file changed, 73 insertions(+), 28 deletions(-) (limited to 'gcc/ada/s-pack03.adb') 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; -- cgit v1.2.1