[multiple changes]
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. From-SVN: r184480
This commit is contained in:
Arnaud Charlet
parent
aab0813011
commit
9aa04cc733
@ -1,3 +1,23 @@
|
||||
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
|
||||
|
||||
@ -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);
|
||||
|
||||
@ -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;
|
||||
|
||||
@ -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 --
|
||||
-- <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;
|
||||
@ -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;
|
||||
|
||||
@ -430,13 +430,11 @@ ATOMICS_BUILTINS_TARGET_PAIRS = \
|
||||
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/'))
|
||||
|
||||
@ -2003,6 +2003,18 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
|
||||
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
|
||||
@ -2173,29 +2185,28 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
|
||||
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]);
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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;
|
||||
|
||||
|
||||
@ -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;
|
||||
|
||||
@ -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;
|
||||
|
||||
Loading…
Reference in New Issue
Block a user