+2012-02-22 Robert Dewar <dewar@adacore.com>
+
+ * exp_util.adb, make.adb, sem_dim.adb, sem_ch4.adb, exp_disp.adb: Minor
+ reformatting.
+
+2012-02-22 Geert Bosch <bosch@adacore.com>
+
+ * 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 <gingold@adacore.com>
+
+ * gcc-interface/decl.c (gnat_to_gnu_entity) [E_String_Type,
+ E_Array_Type]: Translate component ealier.
+
+2012-02-22 Robert Dewar <dewar@adacore.com>
+
+ * par-ch3.adb (P_Signed_Integer_Type_Definition): Specialize
+ error message for 'Range.
+
2012-02-22 Pascal Obry <obry@adacore.com>
* s-taprop-mingw.adb (Finalize_TCB): Do not wait on thread handle as
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);
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
N_Unchecked_Type_Conversion)
then
Call := Expression (Call);
+
else
exit;
end if;
+++ /dev/null
-------------------------------------------------------------------------------
--- --
--- 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 --
--- <http://www.gnu.org/licenses/>. --
--- --
--- 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;
-- --
-- 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- --
-- --
------------------------------------------------------------------------------
--- 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;
--------------
--------------
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;
--------------
--------------
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;
-----------
-----------
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;
-----------
-----------
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;
-----------
-----------
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;
X86_TARGET_PAIRS = \
a-numaux.ads<a-numaux-x86.ads \
a-numaux.adb<a-numaux-x86.adb \
- g-bytswa.adb<g-bytswa-x86.adb \
s-atocou.adb<s-atocou-x86.adb
X86_64_TARGET_PAIRS = \
a-numaux.ads<a-numaux-x86.ads \
a-numaux.adb<a-numaux-x86.adb \
- g-bytswa.adb<g-bytswa-x86.adb \
s-atocou.adb<s-atocou-builtin.adb
LIB_VERSION = $(strip $(shell grep ' Library_Version :' $(fsrcpfx)ada/gnatvsn.ads | sed -e 's/.*"\(.*\)".*/\1/'))
tree gnu_max_size = size_one_node, gnu_max_size_unit, tem, t;
Entity_Id gnat_index, gnat_name;
int index;
+ tree comp_type;
+
+ /* Create the type for the component now, as it simplifies breaking
+ type reference loops. */
+ comp_type
+ = gnat_to_gnu_component_type (gnat_entity, definition, debug_info_p);
+ if (present_gnu_tree (gnat_entity))
+ {
+ /* As a side effect, the type may have been translated. */
+ maybe_present = true;
+ break;
+ }
/* We complete an existing dummy fat pointer type in place. This both
avoids further complex adjustments in update_pointer_to and yields
debug_info_p);
TYPE_READONLY (gnu_template_type) = 1;
- /* Now make the array of arrays and update the pointer to the array
- in the fat pointer. Note that it is the first field. */
- tem
- = gnat_to_gnu_component_type (gnat_entity, definition, debug_info_p);
+ /* Now build the array type. */
/* If Component_Size is not already specified, annotate it with the
size of the component. */
if (Unknown_Component_Size (gnat_entity))
- Set_Component_Size (gnat_entity, annotate_value (TYPE_SIZE (tem)));
+ Set_Component_Size (gnat_entity,
+ annotate_value (TYPE_SIZE (comp_type)));
/* Compute the maximum size of the array in units and bits. */
if (gnu_max_size)
{
gnu_max_size_unit = size_binop (MULT_EXPR, gnu_max_size,
- TYPE_SIZE_UNIT (tem));
+ TYPE_SIZE_UNIT (comp_type));
gnu_max_size = size_binop (MULT_EXPR,
convert (bitsizetype, gnu_max_size),
- TYPE_SIZE (tem));
+ TYPE_SIZE (comp_type));
}
else
gnu_max_size_unit = NULL_TREE;
/* Now build the array type. */
+ tem = comp_type;
for (index = ndim - 1; index >= 0; index--)
{
tem = build_nonshared_array_type (tem, gnu_index_types[index]);
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;
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
-- --
-- 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- --
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;
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.
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;
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 --
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
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);
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;
OSDN Git Service
