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:
parent
c1c84c5ee3
commit
149604e46a
|
@ -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
|
||||
|
|
|
@ -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 --
|
||||
--------------------------------------
|
||||
|
|
|
@ -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);
|
||||
|
||||
|
|
|
@ -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;
|
||||
|
||||
|
|
Loading…
Reference in New Issue