diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 05784e68d5e..f3cf57efdb3 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,23 @@ +2012-02-22 Robert Dewar + + * exp_util.adb, make.adb, sem_dim.adb, sem_ch4.adb, exp_disp.adb: Minor + reformatting. + +2012-02-22 Geert Bosch + + * g-bytswa-x86.adb, g-bytswa.adb, gcc-interface/Makefile.in: Remove + x86-specific version of byteswap and use GCC builtins instead. + +2012-02-22 Tristan Gingold + + * gcc-interface/decl.c (gnat_to_gnu_entity) [E_String_Type, + E_Array_Type]: Translate component ealier. + +2012-02-22 Robert Dewar + + * par-ch3.adb (P_Signed_Integer_Type_Definition): Specialize + error message for 'Range. + 2012-02-22 Pascal Obry * s-taprop-mingw.adb (Finalize_TCB): Do not wait on thread handle as diff --git a/gcc/ada/exp_disp.adb b/gcc/ada/exp_disp.adb index 314862b49fa..e065538c72b 100644 --- a/gcc/ada/exp_disp.adb +++ b/gcc/ada/exp_disp.adb @@ -77,8 +77,9 @@ package body Exp_Disp is function Find_Specific_Type (CW : Entity_Id) return Entity_Id; -- Find specific type of a class-wide type, and handle the case of an - -- incomplete type coming either from a limited_with clause or from an - -- incomplete type declaration. + -- incomplete type coming either from a limited_with clause or from an + -- incomplete type declaration. Shouldn't this be in Sem_Util? It seems + -- like a general purpose semantic routine ??? function Has_DT (Typ : Entity_Id) return Boolean; pragma Inline (Has_DT); diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb index 34bf030e205..96498c2aa11 100644 --- a/gcc/ada/exp_util.adb +++ b/gcc/ada/exp_util.adb @@ -3961,7 +3961,6 @@ package body Exp_Util is function Initialized_By_Ctrl_Function (N : Node_Id) return Boolean is Expr : constant Node_Id := Original_Node (Expression (N)); - begin return Nkind (Expr) = N_Function_Call @@ -3986,6 +3985,7 @@ package body Exp_Util is N_Unchecked_Type_Conversion) then Call := Expression (Call); + else exit; end if; diff --git a/gcc/ada/g-bytswa-x86.adb b/gcc/ada/g-bytswa-x86.adb deleted file mode 100644 index cc47b729835..00000000000 --- a/gcc/ada/g-bytswa-x86.adb +++ /dev/null @@ -1,192 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT RUN-TIME COMPONENTS -- --- -- --- G N A T . B Y T E _ S W A P P I N G -- --- -- --- B o d y -- --- -- --- Copyright (C) 2006-2010, AdaCore -- --- -- --- 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- -- --- ware Foundation; either version 3, or (at your option) any later ver- -- --- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- --- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- --- or FITNESS FOR A PARTICULAR PURPOSE. -- --- -- --- As a special exception under Section 7 of GPL version 3, you are granted -- --- additional permissions described in the GCC Runtime Library Exception, -- --- version 3.1, as published by the Free Software Foundation. -- --- -- --- You should have received a copy of the GNU General Public License and -- --- a copy of the GCC Runtime Library Exception along with this program; -- --- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- --- . -- --- -- --- GNAT was originally developed by the GNAT team at New York University. -- --- Extensive contributions were provided by Ada Core Technologies Inc. -- --- -- ------------------------------------------------------------------------------- - --- This is a machine-specific version of this package. --- It uses instructions available on Intel 486 processors (or later). - -with Interfaces; use Interfaces; -with System.Machine_Code; use System.Machine_Code; -with Ada.Unchecked_Conversion; - -package body GNAT.Byte_Swapping is - - ----------------------- - -- Local Subprograms -- - ----------------------- - - function Swapped32 (Value : Unsigned_32) return Unsigned_32; - pragma Inline_Always (Swapped32); - - -------------- - -- Swapped2 -- - -------------- - - function Swapped2 (Input : Item) return Item is - - function As_U16 is new Ada.Unchecked_Conversion - (Source => Item, Target => Unsigned_16); - - function As_Item is new Ada.Unchecked_Conversion - (Source => Unsigned_16, Target => Item); - - X : Unsigned_16 := As_U16 (Input); - - begin - Asm ("xchgb %b0,%h0", - Unsigned_16'Asm_Output ("=q", X), - Unsigned_16'Asm_Input ("0", X)); - return As_Item (X); - end Swapped2; - - -------------- - -- Swapped4 -- - -------------- - - function Swapped4 (Input : Item) return Item is - - function As_U32 is new Ada.Unchecked_Conversion - (Source => Item, Target => Unsigned_32); - - function As_Item is new Ada.Unchecked_Conversion - (Source => Unsigned_32, Target => Item); - - X : Unsigned_32 := As_U32 (Input); - - begin - Asm ("bswap %0", - Unsigned_32'Asm_Output ("=r", X), - Unsigned_32'Asm_Input ("0", X)); - return As_Item (X); - end Swapped4; - - -------------- - -- Swapped8 -- - -------------- - - function Swapped8 (Input : Item) return Item is - - function As_U64 is new Ada.Unchecked_Conversion - (Source => Item, Target => Unsigned_64); - - X : constant Unsigned_64 := As_U64 (Input); - - type Two_Words is array (0 .. 1) of Unsigned_32; - for Two_Words'Component_Size use Unsigned_32'Size; - - function As_Item is new Ada.Unchecked_Conversion - (Source => Two_Words, Target => Item); - - Result : Two_Words; - - begin - Asm ("xchgl %0,%1", - Outputs => - (Unsigned_32'Asm_Output ("=r", Result (0)), - Unsigned_32'Asm_Output ("=r", Result (1))), - Inputs => - (Unsigned_32'Asm_Input ("0", - Swapped32 (Unsigned_32 (X and 16#0000_0000_FFFF_FFFF#))), - Unsigned_32'Asm_Input ("1", - Swapped32 (Unsigned_32 (Shift_Right (X, 32)))))); - return As_Item (Result); - end Swapped8; - - ----------- - -- Swap2 -- - ----------- - - procedure Swap2 (Location : System.Address) is - - X : Unsigned_16; - for X'Address use Location; - - begin - Asm ("xchgb %b0,%h0", - Unsigned_16'Asm_Output ("=q", X), - Unsigned_16'Asm_Input ("0", X)); - end Swap2; - - ----------- - -- Swap4 -- - ----------- - - procedure Swap4 (Location : System.Address) is - - X : Unsigned_32; - for X'Address use Location; - - begin - Asm ("bswap %0", - Unsigned_32'Asm_Output ("=r", X), - Unsigned_32'Asm_Input ("0", X)); - end Swap4; - - --------------- - -- Swapped32 -- - --------------- - - function Swapped32 (Value : Unsigned_32) return Unsigned_32 is - X : Unsigned_32 := Value; - begin - Asm ("bswap %0", - Unsigned_32'Asm_Output ("=r", X), - Unsigned_32'Asm_Input ("0", X)); - return X; - end Swapped32; - - ----------- - -- Swap8 -- - ----------- - - procedure Swap8 (Location : System.Address) is - - X : Unsigned_64; - for X'Address use Location; - - type Two_Words is array (0 .. 1) of Unsigned_32; - for Two_Words'Component_Size use Unsigned_32'Size; - - Words : Two_Words; - for Words'Address use Location; - - begin - Asm ("xchgl %0,%1", - Outputs => - (Unsigned_32'Asm_Output ("=r", Words (0)), - Unsigned_32'Asm_Output ("=r", Words (1))), - Inputs => - (Unsigned_32'Asm_Input ("0", - Swapped32 (Unsigned_32 (X and 16#0000_0000_FFFF_FFFF#))), - Unsigned_32'Asm_Input ("1", - Swapped32 (Unsigned_32 (Shift_Right (X, 32)))))); - end Swap8; - -end GNAT.Byte_Swapping; diff --git a/gcc/ada/g-bytswa.adb b/gcc/ada/g-bytswa.adb index a4e629d16e7..329c078fff4 100644 --- a/gcc/ada/g-bytswa.adb +++ b/gcc/ada/g-bytswa.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2006-2010, AdaCore -- +-- Copyright (C) 2006-2012, AdaCore -- -- -- -- 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- -- @@ -29,31 +29,40 @@ -- -- ------------------------------------------------------------------------------ --- This is a general implementation that does not take advantage of --- any machine-specific instructions. +-- This is a general implementation that uses GCC intrinsics to take +-- advantage of any machine-specific instructions. -with Interfaces; use Interfaces; -with Ada.Unchecked_Conversion; +with Ada.Unchecked_Conversion; use Ada; package body GNAT.Byte_Swapping is + type U16 is mod 2**16; + type U32 is mod 2**32; + type U64 is mod 2**64; + + function Bswap_16 (X : U16) return U16 is (X / 256 or X * 256); + -- The above is an idiom recognized by GCC + + function Bswap_32 (X : U32) return U32; + pragma Import (Intrinsic, Bswap_32, "__builtin_bswap32"); + + function Bswap_64 (X : U64) return U64; + pragma Import (Intrinsic, Bswap_64, "__builtin_bswap64"); + -------------- -- Swapped2 -- -------------- function Swapped2 (Input : Item) return Item is + function As_U16 is new Unchecked_Conversion (Item, U16); + function As_Item is new Unchecked_Conversion (U16, Item); - function As_U16 is new Ada.Unchecked_Conversion - (Source => Item, Target => Unsigned_16); - - function As_Item is new Ada.Unchecked_Conversion - (Source => Unsigned_16, Target => Item); - - X : constant Unsigned_16 := As_U16 (Input); - + function Bswap_16 (X : U16) return U16 is (X / 256 or X * 256); + -- ??? Need to have function local here to allow inlining + pragma Compile_Time_Error (Item'Max_Size_In_Storage_Elements /= 2, + "storage size must be 2 bytes"); begin - return As_Item ((Shift_Left (X, 8) and 16#FF00#) or - (Shift_Right (X, 8) and 16#00FF#)); + return As_Item (Bswap_16 (As_U16 (Input))); end Swapped2; -------------- @@ -61,20 +70,12 @@ package body GNAT.Byte_Swapping is -------------- function Swapped4 (Input : Item) return Item is - - function As_U32 is new Ada.Unchecked_Conversion - (Source => Item, Target => Unsigned_32); - - function As_Item is new Ada.Unchecked_Conversion - (Source => Unsigned_32, Target => Item); - - X : constant Unsigned_32 := As_U32 (Input); - + function As_U32 is new Unchecked_Conversion (Item, U32); + function As_Item is new Unchecked_Conversion (U32, Item); + pragma Compile_Time_Error (Item'Max_Size_In_Storage_Elements /= 4, + "storage size must be 4 bytes"); begin - return As_Item ((Shift_Right (X, 24) and 16#0000_00FF#) or - (Shift_Right (X, 8) and 16#0000_FF00#) or - (Shift_Left (X, 8) and 16#00FF_0000#) or - (Shift_Left (X, 24) and 16#FF00_0000#)); + return As_Item (Bswap_32 (As_U32 (Input))); end Swapped4; -------------- @@ -82,24 +83,12 @@ package body GNAT.Byte_Swapping is -------------- function Swapped8 (Input : Item) return Item is - - function As_U64 is new Ada.Unchecked_Conversion - (Source => Item, Target => Unsigned_64); - - function As_Item is new Ada.Unchecked_Conversion - (Source => Unsigned_64, Target => Item); - - X : constant Unsigned_64 := As_U64 (Input); - - Low, High : aliased Unsigned_32; - + function As_U64 is new Unchecked_Conversion (Item, U64); + function As_Item is new Unchecked_Conversion (U64, Item); + pragma Compile_Time_Error (Item'Max_Size_In_Storage_Elements /= 8, + "storage size must be 8 bytes"); begin - Low := Unsigned_32 (X and 16#0000_0000_FFFF_FFFF#); - Swap4 (Low'Address); - High := Unsigned_32 (Shift_Right (X, 32)); - Swap4 (High'Address); - return As_Item - (Shift_Left (Unsigned_64 (Low), 32) or Unsigned_64 (High)); + return As_Item (Bswap_64 (As_U64 (Input))); end Swapped8; ----------- @@ -107,11 +96,10 @@ package body GNAT.Byte_Swapping is ----------- procedure Swap2 (Location : System.Address) is - X : Unsigned_16; + X : U16; for X'Address use Location; begin - X := (Shift_Left (X, 8) and 16#FF00#) or - (Shift_Right (X, 8) and 16#00FF#); + X := Bswap_16 (X); end Swap2; ----------- @@ -119,13 +107,10 @@ package body GNAT.Byte_Swapping is ----------- procedure Swap4 (Location : System.Address) is - X : Unsigned_32; + X : U32; for X'Address use Location; begin - X := (Shift_Right (X, 24) and 16#0000_00FF#) or - (Shift_Right (X, 8) and 16#0000_FF00#) or - (Shift_Left (X, 8) and 16#00FF_0000#) or - (Shift_Left (X, 24) and 16#FF00_0000#); + X := Bswap_32 (X); end Swap4; ----------- @@ -133,17 +118,9 @@ package body GNAT.Byte_Swapping is ----------- procedure Swap8 (Location : System.Address) is - X : Unsigned_64; + X : U64; for X'Address use Location; - - Low, High : aliased Unsigned_32; - begin - Low := Unsigned_32 (X and 16#0000_0000_FFFF_FFFF#); - Swap4 (Low'Address); - High := Unsigned_32 (Shift_Right (X, 32)); - Swap4 (High'Address); - X := Shift_Left (Unsigned_64 (Low), 32) or Unsigned_64 (High); + X := Bswap_64 (X); end Swap8; - end GNAT.Byte_Swapping; diff --git a/gcc/ada/gcc-interface/Makefile.in b/gcc/ada/gcc-interface/Makefile.in index d81c66312a0..72569032a10 100644 --- a/gcc/ada/gcc-interface/Makefile.in +++ b/gcc/ada/gcc-interface/Makefile.in @@ -430,13 +430,11 @@ ATOMICS_BUILTINS_TARGET_PAIRS = \ X86_TARGET_PAIRS = \ a-numaux.ads= 0; index--) { tem = build_nonshared_array_type (tem, gnu_index_types[index]); diff --git a/gcc/ada/make.adb b/gcc/ada/make.adb index 0b1cd09b44c..e2512a0678c 100644 --- a/gcc/ada/make.adb +++ b/gcc/ada/make.adb @@ -1865,7 +1865,7 @@ package body Make is elsif not Read_Only and then Main_Project /= No_Project then declare Uname : constant Name_Id := - Check_Source_Info_In_ALI (ALI, Project_Tree); + Check_Source_Info_In_ALI (ALI, Project_Tree); Udata : Prj.Unit_Index; @@ -1875,11 +1875,11 @@ package body Make is return; end if; - -- Check that the ALI file is in the correct object - -- directory. If it is in the object directory of a project - -- that is extended and it depends on a source that is in - -- one of its extending projects, then the ALI file is not - -- in the correct object directory. + -- Check that ALI file is in the correct object directory. + -- If it is in the object directory of a project that is + -- extended and it depends on a source that is in one of + -- its extending projects, then the ALI file is not in the + -- correct object directory. -- First, find the project of this ALI file. As there may be -- several projects with the same object directory, we first diff --git a/gcc/ada/par-ch3.adb b/gcc/ada/par-ch3.adb index ef017f08960..bfc4f592bf3 100644 --- a/gcc/ada/par-ch3.adb +++ b/gcc/ada/par-ch3.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2011, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2012, 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- -- @@ -2279,13 +2279,30 @@ package body Ch3 is Scan; -- past RANGE end if; - Expr_Node := P_Expression; - Check_Simple_Expression (Expr_Node); - Set_Low_Bound (Typedef_Node, Expr_Node); - T_Dot_Dot; - Expr_Node := P_Expression; - Check_Simple_Expression (Expr_Node); - Set_High_Bound (Typedef_Node, Expr_Node); + Expr_Node := P_Expression_Or_Range_Attribute; + + -- Range case (not permitted by the grammar, this is surprising but + -- the grammar in the RM is as quoted above, and does not allow Range). + + if Expr_Form = EF_Range_Attr then + Error_Msg_N + ("Range attribute not allowed here, use First .. Last", Expr_Node); + Set_Low_Bound (Typedef_Node, Expr_Node); + Set_Attribute_Name (Expr_Node, Name_First); + Set_High_Bound (Typedef_Node, Copy_Separate_Tree (Expr_Node)); + Set_Attribute_Name (High_Bound (Typedef_Node), Name_Last); + + -- Normal case of explicit range + + else + Check_Simple_Expression (Expr_Node); + Set_Low_Bound (Typedef_Node, Expr_Node); + T_Dot_Dot; + Expr_Node := P_Expression; + Check_Simple_Expression (Expr_Node); + Set_High_Bound (Typedef_Node, Expr_Node); + end if; + return Typedef_Node; end P_Signed_Integer_Type_Definition; diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb index 2b343aa0c4c..0a9cb78c087 100644 --- a/gcc/ada/sem_ch4.adb +++ b/gcc/ada/sem_ch4.adb @@ -5543,10 +5543,10 @@ package body Sem_Ch4 is return; end if; - -- If we have infix notation, the operator must be usable. - -- Within an instance, if the type is already established we - -- know it is correct. If an operand is universal it is compatible - -- with any numeric type. + -- If we have infix notation, the operator must be usable. Within + -- an instance, if the type is already established we know it is + -- correct. If an operand is universal it is compatible with any + -- numeric type. -- In Ada 2005, the equality on anonymous access types is declared -- in Standard, and is always visible. @@ -5554,15 +5554,13 @@ package body Sem_Ch4 is elsif In_Open_Scopes (Scope (Bas)) or else Is_Potentially_Use_Visible (Bas) or else In_Use (Bas) - or else (In_Use (Scope (Bas)) - and then not Is_Hidden (Bas)) - + or else (In_Use (Scope (Bas)) and then not Is_Hidden (Bas)) or else (In_Instance - and then - (First_Subtype (T1) = First_Subtype (Etype (R)) - or else (Is_Numeric_Type (T1) - and then Is_Universal_Numeric_Type (Etype (R))))) - + and then + (First_Subtype (T1) = First_Subtype (Etype (R)) + or else + (Is_Numeric_Type (T1) + and then Is_Universal_Numeric_Type (Etype (R))))) or else Ekind (T1) = E_Anonymous_Access_Type then null; diff --git a/gcc/ada/sem_dim.adb b/gcc/ada/sem_dim.adb index d95e7081527..7e0d5d4a7dc 100644 --- a/gcc/ada/sem_dim.adb +++ b/gcc/ada/sem_dim.adb @@ -1373,9 +1373,8 @@ package body Sem_Dim is Ent : Entity_Id; function Is_Elementary_Function_Entity (E : Entity_Id) return Boolean; - -- Given E the original subprogram entity, return True if the call is a - -- an elementary function call (see - -- Ada.Numerics.Generic_Elementary_Functions). + -- Given E, the original subprogram entity, return True if call is to an + -- elementary function (see Ada.Numerics.Generic_Elementary_Functions). ----------------------------------- -- Is_Elementary_Function_Entity -- @@ -1385,8 +1384,7 @@ package body Sem_Dim is Loc : constant Source_Ptr := Sloc (E); begin - -- Check the function entity is located in - -- Ada.Numerics.Generic_Elementary_Functions. + -- Is function entity in Ada.Numerics.Generic_Elementary_Functions? return Loc > No_Location @@ -1422,8 +1420,8 @@ package body Sem_Dim is if Exists (Dims_Of_Call) then for Position in Dims_Of_Call'Range loop Dims_Of_Call (Position) := - Dims_Of_Call (Position) * Rational'(Numerator => 1, - Denominator => 2); + Dims_Of_Call (Position) * Rational'(Numerator => 1, + Denominator => 2); end loop; Set_Dimensions (N, Dims_Of_Call); @@ -1440,8 +1438,7 @@ package body Sem_Dim is if Exists (Dims_Of_Actual) then Error_Msg_NE ("parameter should be dimensionless for " & "elementary function&", - Actual, - Name_Call); + Actual, Name_Call); Error_Msg_N ("\parameter " & Dimensions_Msg_Of (Actual), Actual); end if;