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

gcc/ada/ChangeLog

+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

gcc/ada/einfo.ads

@@ -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 --
 --------------------------------------

gcc/ada/s-arit64.adb

@@ -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);
 

gcc/ada/sem_prag.adb

@@ -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;