OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

einfo.ads (Can_Never_Be_Null): Minor comment update. 

2014-05-21  Robert Dewar  <dewar@adacore.com>

	* einfo.ads (Can_Never_Be_Null): Minor comment update.
	* sem_prag.adb (Check_Arg_Is_Task_Dispatching_Policy): Minor
	error message change.
	* s-arit64.adb ("abs"): New function. Use expression functions
	for the simple conversions and arithmetic.

From-SVN: r210688
This commit is contained in:
Robert Dewar 2014-05-21 10:45:27 +00:00 committed by Arnaud Charlet
parent c1c84c5ee3
commit 149604e46a
4 changed files with 94 additions and 98 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
gcc/ada/ChangeLog
View File

@ -1,3 +1,11 @@
2014-05-21 Robert Dewar <dewar@adacore.com>
* einfo.ads (Can_Never_Be_Null): Minor comment update.
* sem_prag.adb (Check_Arg_Is_Task_Dispatching_Policy): Minor
error message change.
* s-arit64.adb ("abs"): New function. Use expression functions
for the simple conversions and arithmetic.
2014-05-18 Eric Botcazou <ebotcazou@adacore.com>
* gcc-interface/trans.c (Subprogram_Body_to_gnu): Rework comment and

64
gcc/ada/einfo.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2013, 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- --
@ -518,19 +518,19 @@ package Einfo is
-- Export pragma).
-- Can_Never_Be_Null (Flag38)
-- This flag is defined in all entities, but can only be set in an object
-- which can never have a null value. Set for constant access values
-- initialized to a non-null value. This is also set for all access
-- parameters in Ada 83 and Ada 95 modes, and for access parameters
-- that explicitly exclude null in Ada 2005.
-- This flag is defined in all entities. It is set in an object which can
-- never have a null value. Set for constant access values initialized to
-- a non-null value. This is also set for all access parameters in Ada 83
-- and Ada 95 modes, and for access parameters that explicitly exclude
-- exclude null in Ada 2005 mode.
--
-- This is used to avoid unnecessary resetting of the Is_Known_Non_Null
-- flag for such entities. In Ada 2005 mode, this is also used when
-- determining subtype conformance of subprogram profiles to ensure
-- that two formals have the same null-exclusion status.
--
-- ??? This is also set on some access types, eg the Etype of the
-- anonymous access type of a controlling formal.
-- This is also set on some access types, e.g. the Etype of the anonymous
-- access type of a controlling formal.
-- Can_Use_Internal_Rep (Flag229) [base type only]
-- Defined in Access_Subprogram_Kind nodes. This flag is set by the
@ -4114,6 +4114,54 @@ package Einfo is
-- Defined in functions and procedures which have been classified as
-- Is_Primitive_Wrapper. Set to the entity being wrapper.
---------------------------
-- Renaming and aliasing --
---------------------------
-- Several entity attributes relate to renaming constructs, and to the use
-- of different names to refer to the same entity. Here is a summary of
-- these constructs and their prefered uses.
-- There are three related attributes:
--
-- Renamed_Entity
-- Renamed_Object
-- Alias
--
-- They all overlap because they are supposed to apply to different entity
-- kinds, and are semantically related, but they have the following intended
-- uses:
--
-- a) Renamed_Entity appplies to entities in renaming declarations that rename
-- an entity, so the value of the attribute IS an entity. This applies to
-- generic renamings, package renamings, exception renamings, and subprograms
-- renamings that rename a subprogram (rather than an attribute, an entry, a
-- protected operation, etc).
--
-- b) Alias applies to overloadable entities, and the value is an overloadable
-- entity. so this is a subset of the previous one. We use the term Alias to
-- cover both renamings and inherited operations, because both cases are
-- handled in the same way when expanding a call. namely the Alias of a given
-- subprogram is the subprogram that will actually be called.
-- Both a) and b) are set transitively, so that in fact it is not necessary to
-- traverse chains of renamings when looking for the original entity: it's
-- there in one step (this is done when analyzing renaming declarations other
-- than object renamings in sem_ch8).
-- c) Renamed_Object applies to constants and variables. Given that the name
-- in an object renaming declaration is not necessarily an entity name, the
-- value of the attribute is the tree for that name, eg AR (1).Comp. The case
-- when that name is in fact an entity is not handled specially. This is why
-- in a few cases we need to use a loop to trace a chain of object renamings
-- where all of them happen to be entities. So:
-- X : integer;
-- Y : integer renames X; -- renamed object is the identifier X
-- Z : integer renames Y; -- renamed object is the identifier Y
-- The front-end does not store explicitly the fact that Z renames X.
--------------------------------------
-- Delayed Freezing and Elaboration --
--------------------------------------

116
gcc/ada/s-arit64.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2013, 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- --
@ -30,6 +30,7 @@
------------------------------------------------------------------------------
with Interfaces; use Interfaces;
with Ada.Unchecked_Conversion;
package body System.Arith_64 is
@ -47,35 +48,42 @@ package body System.Arith_64 is
-- Local Subprograms --
-----------------------
function "+" (A, B : Uns32) return Uns64;
function "+" (A : Uns64; B : Uns32) return Uns64;
function "+" (A, B : Uns32) return Uns64 is (Uns64 (A) + Uns64 (B));
function "+" (A : Uns64; B : Uns32) return Uns64 is
(A + Uns64 (B));
pragma Inline ("+");
-- Length doubling additions
function "*" (A, B : Uns32) return Uns64;
function "*" (A, B : Uns32) return Uns64 is (Uns64 (A) * Uns64 (B));
pragma Inline ("*");
-- Length doubling multiplication
function "/" (A : Uns64; B : Uns32) return Uns64;
function "/" (A : Uns64; B : Uns32) return Uns64 is (A / Uns64 (B));
pragma Inline ("/");
-- Length doubling division
function "rem" (A : Uns64; B : Uns32) return Uns64;
pragma Inline ("rem");
-- Length doubling remainder
function "&" (Hi, Lo : Uns32) return Uns64;
function "&" (Hi, Lo : Uns32) return Uns64 is
(Shift_Left (Uns64 (Hi), 32) or Uns64 (Lo));
pragma Inline ("&");
-- Concatenate hi, lo values to form 64-bit result
function "abs" (X : Int64) return Uns64 is
(if X = Int64'First then 2**63 else Uns64 (Int64'(abs X)));
-- Convert absolute value of X to unsigned. Note that we can't just use
-- the expression of the Else, because it overflows for X = Int64'First.
function "rem" (A : Uns64; B : Uns32) return Uns64 is (A rem Uns64 (B));
pragma Inline ("rem");
-- Length doubling remainder
function Le3 (X1, X2, X3 : Uns32; Y1, Y2, Y3 : Uns32) return Boolean;
-- Determines if 96 bit value X1&X2&X3 <= Y1&Y2&Y3
function Lo (A : Uns64) return Uns32;
function Lo (A : Uns64) return Uns32 is (Uns32 (A and 16#FFFF_FFFF#));
pragma Inline (Lo);
-- Low order half of 64-bit value
function Hi (A : Uns64) return Uns32;
function Hi (A : Uns64) return Uns32 is (Uns32 (Shift_Right (A, 32)));
pragma Inline (Hi);
-- High order half of 64-bit value
@ -97,56 +105,6 @@ package body System.Arith_64 is
pragma No_Return (Raise_Error);
-- Raise constraint error with appropriate message
---------
-- "&" --
---------
function "&" (Hi, Lo : Uns32) return Uns64 is
begin
return Shift_Left (Uns64 (Hi), 32) or Uns64 (Lo);
end "&";
---------
-- "*" --
---------
function "*" (A, B : Uns32) return Uns64 is
begin
return Uns64 (A) * Uns64 (B);
end "*";
---------
-- "+" --
---------
function "+" (A, B : Uns32) return Uns64 is
begin
return Uns64 (A) + Uns64 (B);
end "+";
function "+" (A : Uns64; B : Uns32) return Uns64 is
begin
return A + Uns64 (B);
end "+";
---------
-- "/" --
---------
function "/" (A : Uns64; B : Uns32) return Uns64 is
begin
return A / Uns64 (B);
end "/";
-----------
-- "rem" --
-----------
function "rem" (A : Uns64; B : Uns32) return Uns64 is
begin
return A rem Uns64 (B);
end "rem";
--------------------------
-- Add_With_Ovflo_Check --
--------------------------
@ -178,13 +136,13 @@ package body System.Arith_64 is
Q, R : out Int64;
Round : Boolean)
is
Xu : constant Uns64 := To_Uns (abs X);
Yu : constant Uns64 := To_Uns (abs Y);
Xu : constant Uns64 := abs X;
Yu : constant Uns64 := abs Y;
Yhi : constant Uns32 := Hi (Yu);
Ylo : constant Uns32 := Lo (Yu);
Zu : constant Uns64 := To_Uns (abs Z);
Zu : constant Uns64 := abs Z;
Zhi : constant Uns32 := Hi (Zu);
Zlo : constant Uns32 := Lo (Zu);
@ -260,15 +218,6 @@ package body System.Arith_64 is
end if;
end Double_Divide;
--------
-- Hi --
--------
function Hi (A : Uns64) return Uns32 is
begin
return Uns32 (Shift_Right (A, 32));
end Hi;
---------
-- Le3 --
---------
@ -288,25 +237,16 @@ package body System.Arith_64 is
end if;
end Le3;
--------
-- Lo --
--------
function Lo (A : Uns64) return Uns32 is
begin
return Uns32 (A and 16#FFFF_FFFF#);
end Lo;
-------------------------------
-- Multiply_With_Ovflo_Check --
-------------------------------
function Multiply_With_Ovflo_Check (X, Y : Int64) return Int64 is
Xu : constant Uns64 := To_Uns (abs X);
Xu : constant Uns64 := abs X;
Xhi : constant Uns32 := Hi (Xu);
Xlo : constant Uns32 := Lo (Xu);
Yu : constant Uns64 := To_Uns (abs Y);
Yu : constant Uns64 := abs Y;
Yhi : constant Uns32 := Hi (Yu);
Ylo : constant Uns32 := Lo (Yu);
@ -373,15 +313,15 @@ package body System.Arith_64 is
Q, R : out Int64;
Round : Boolean)
is
Xu : constant Uns64 := To_Uns (abs X);
Xu : constant Uns64 := abs X;
Xhi : constant Uns32 := Hi (Xu);
Xlo : constant Uns32 := Lo (Xu);
Yu : constant Uns64 := To_Uns (abs Y);
Yu : constant Uns64 := abs Y;
Yhi : constant Uns32 := Hi (Yu);
Ylo : constant Uns32 := Lo (Yu);
Zu : Uns64 := To_Uns (abs Z);
Zu : Uns64 := abs Z;
Zhi : Uns32 := Hi (Zu);
Zlo : Uns32 := Lo (Zu);

4
gcc/ada/sem_prag.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2013, 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- --
@ -4021,7 +4021,7 @@ package body Sem_Prag is
if not Is_Task_Dispatching_Policy_Name (Chars (Argx)) then
Error_Pragma_Arg
("& is not a valid task dispatching policy name", Argx);
("& is not an allowed task dispatching policy name", Argx);
end if;
end Check_Arg_Is_Task_Dispatching_Policy;