s-bignum.adb (Big_Exp): 0**0 should be 1, not 0.

2012-10-02  Robert Dewar  <dewar@adacore.com>

	* s-bignum.adb (Big_Exp): 0**0 should be 1, not 0.
	(Big_Exp): Fix possible error for (-1)**0.
	(Big_Exp): Fix error in computing 2**K for small K.
	(Big_Mod): Fix wrong sign for negative operands.
	(Div_Rem): Fix bad results for operands close to 2**63.
	* s-bignum.ads: Add documentation and an assertion to require
	LLI size to be 64 bits.
	* sem_prag.adb (Analyze_Pragma, case Overflow_Checks): Do not
	allow ELIMINATED if LLI'Size is other than 64 bits.
	* switch-c.adb (Scan_Switches): Do not allow -gnato3 if LLI'Size
	is not 64 bits.
	* switch.ads (Bad_Switch): Add missing pragma No_Return.
	* gnat_ugn.texi: Added appendix on Overflow Check Handling in GNAT.

2012-10-02  Robert Dewar  <dewar@adacore.com>

	* sem_type.adb: Minor reformatting.

From-SVN: r191979

gcc/ada/ChangeLog

 2012-10-02  Robert Dewar  <dewar@adacore.com>
 
+	* s-bignum.adb (Big_Exp): 0**0 should be 1, not 0.
+	(Big_Exp): Fix possible error for (-1)**0.
+	(Big_Exp): Fix error in computing 2**K for small K.
+	(Big_Mod): Fix wrong sign for negative operands.
+	(Div_Rem): Fix bad results for operands close to 2**63.
+	* s-bignum.ads: Add documentation and an assertion to require
+	LLI size to be 64 bits.
+	* sem_prag.adb (Analyze_Pragma, case Overflow_Checks): Do not
+	allow ELIMINATED if LLI'Size is other than 64 bits.
+	* switch-c.adb (Scan_Switches): Do not allow -gnato3 if LLI'Size
+	is not 64 bits.
+	* switch.ads (Bad_Switch): Add missing pragma No_Return.
+	* gnat_ugn.texi: Added appendix on Overflow Check Handling in GNAT.
+
+2012-10-02  Robert Dewar  <dewar@adacore.com>
+
+	* sem_type.adb: Minor reformatting.
+
+2012-10-02  Robert Dewar  <dewar@adacore.com>
+
 	* sem_ch8.adb: Minor reformatting.
 
 2012-10-02  Javier Miranda  <miranda@adacore.com>

gcc/ada/s-bignum.adb

@@ -42,7 +42,7 @@ package body System.Bignums is
    use Interfaces;
    --  So that operations on Unsigned_32 are available
 
-   type DD is mod SD'Modulus ** 2;
+   type DD is mod Base ** 2;
    --  Double length digit used for intermediate computations
 
    function MSD (X : DD) return SD is (SD (X / Base));
@@ -361,7 +361,12 @@ package body System.Bignums is
       if Y.Neg then
          raise Constraint_Error with "exponentiation to negative power";
 
-      --  0 ** X is always 0
+      --  X ** 0 is always 1 (including 0 ** 0, so do this test first)
+
+      elsif Y.Len = 0 then
+         return Normalize (One_Data);
+
+      --  0 ** X is always 0 (for X non-zero)
 
       elsif X.Len = 0 then
          return Normalize (Zero_Data);
@@ -380,12 +385,12 @@ package body System.Bignums is
       elsif Y.Len > 1 then
          raise Storage_Error with "exponentiation result is too large";
 
-      --  Special case (+/-)2 ** K, where K is 31 or less using a shift
+      --  Special case (+/-)2 ** K, where K is 1 .. 31 using a shift
 
       elsif X.Len = 1 and then X.D (1) = 2 and then Y.D (1) < 32 then
          declare
             D : constant Digit_Vector (1 .. 1) :=
-                  (1 => Shift_Left (SD'(1), Natural (Y.D (1) - 1)));
+                  (1 => Shift_Left (SD'(1), Natural (Y.D (1))));
          begin
             return Normalize (D, X.Neg);
          end;
@@ -492,7 +497,7 @@ package body System.Bignums is
             declare
                T1 : constant Bignum := Big_Sub (Y, R);
             begin
-               T1.Neg := X.Neg;
+               T1.Neg := Y.Neg;
                Free_Bignum (R);
                return T1;
             end;
@@ -597,7 +602,7 @@ package body System.Bignums is
 
    function Big_Sub (X, Y : Bignum) return Bignum is
    begin
-      --  If right operand zero, return left operand
+      --  If right operand zero, return left operand (avoiding sharing)
 
       if Y.Len = 0 then
          return Normalize (X.D, X.Neg);
@@ -668,13 +673,13 @@ package body System.Bignums is
          Quotient  := Normalize (Zero_Data);
          return;
 
-      --  If both X and Y are comfortably less than 2**63-1, we can just use
-      --  Long_Long_Integer arithmetic. Note it is good not to do an accurate
-      --  range check here since -2**63 / -1 overflows!
+      --  If both X and Y are less than 2**63-1, we can use Long_Long_Integer
+      --  arithmetic. Note it is good not to do an accurate range check against
+      --  Long_Long_Integer since -2**63 / -1 overflows!
 
-      elsif (X.Len <= 1 or else (X.Len = 2 and then X.D (1) <= 2**31))
+      elsif (X.Len <= 1 or else (X.Len = 2 and then X.D (1) < 2**31))
               and then
-            (Y.Len <= 1 or else (Y.Len = 2 and then Y.D (1) <= 2**31))
+            (Y.Len <= 1 or else (Y.Len = 2 and then Y.D (1) < 2**31))
       then
          declare
             A : constant LLI := abs (From_Bignum (X));

gcc/ada/s-bignum.ads

@@ -31,12 +31,17 @@
 
 --  This package provides arbitrary precision signed integer arithmetic for
 --  use in computing intermediate values in expressions for the case where
---  pragma Overflow_Check (Eliminate) is in effect.
+--  pragma Overflow_Check (Eliminated) is in effect.
 
 with Interfaces;
 
 package System.Bignums is
 
+   pragma Assert (Long_Long_Integer'Size = 64);
+   --  This package assumes that Long_Long_Integer size is 64 bit (i.e. that it
+   --  has a range of -2**63 to 2**63-1). The front end ensures that the mode
+   --  ELIMINATED is not allowed for overflow checking if this is not the case.
+
    subtype Length is Natural range 0 .. 2 ** 23 - 1;
    --  Represent number of words in Digit_Vector
 
@@ -65,6 +70,10 @@ package System.Bignums is
    end record;
 
    type Bignum is access all Bignum_Data;
+   --  This the type that is used externally. Possibly this could be a private
+   --  type, but we leave the structure exposed for now. For one thing it helps
+   --  with debugging. Note that this package never shares an allocated Bignum
+   --  value, so for example for X + 0, a copy of X is returned, not X itself.
 
    --  Note: none of the subprograms in this package modify the Bignum_Data
    --  records referenced by Bignum arguments of mode IN.

gcc/ada/sem_prag.adb

@@ -11773,6 +11773,9 @@ package body Sem_Prag is
 
          --  MODE := SUPPRESSED | CHECKED | MINIMIZED | ELIMINATED
 
+         --  Note: MINIMIZED is allowed only if Long_Long_Integer'Size is 64
+         --  since System.Bignums makes this assumption.
+
          when Pragma_Overflow_Checks => Overflow_Checks : declare
             function Get_Check_Mode
               (Name : Name_Id;
@@ -11797,12 +11800,21 @@ package body Sem_Prag is
 
                if Chars (Argx) = Name_Suppressed then
                   return Suppressed;
+
                elsif Chars (Argx) = Name_Checked then
                   return Checked;
+
                elsif Chars (Argx) = Name_Minimized then
                   return Minimized;
+
                elsif Chars (Argx) = Name_Eliminated then
-                  return Eliminated;
+                  if Ttypes.Standard_Long_Long_Integer_Size /= 64 then
+                     Error_Pragma_Arg
+                       ("Eliminated not implemented on this target", Argx);
+                  else
+                     return Eliminated;
+                  end if;
+
                else
                   Error_Pragma_Arg ("invalid argument for pragma%", Argx);
                end if;

gcc/ada/sem_type.adb

@@ -741,7 +741,6 @@ package body Sem_Type is
    ------------
 
    function Covers (T1, T2 : Entity_Id) return Boolean is
-
       BT1 : Entity_Id;
       BT2 : Entity_Id;
 

gcc/ada/switch-c.adb

@@ -33,6 +33,7 @@ with Osint;    use Osint;
 with Opt;      use Opt;
 with Validsw;  use Validsw;
 with Stylesw;  use Stylesw;
+with Ttypes;   use Ttypes;
 with Warnsw;   use Warnsw;
 
 with Ada.Unchecked_Deallocation;
@@ -50,6 +51,10 @@ package body Switch.C is
       new Ada.Unchecked_Deallocation (String_List, String_List_Access);
    --  Avoid using System.Strings.Free, which also frees the designated strings
 
+   function Get_Overflow_Mode (C : Character) return Overflow_Check_Type;
+   --  Given a digit in the range 0 .. 3, returns the corresponding value of
+   --  Overflow_Check_Type. Raises program error if C is outside this range.
+
    function Switch_Subsequently_Cancelled
      (C        : String;
       Args     : String_List;
@@ -72,7 +77,6 @@ package body Switch.C is
          declare
             New_Symbol_Definitions : constant String_List_Access :=
               new String_List (1 .. 2 * Preprocessing_Symbol_Last);
-
          begin
             New_Symbol_Definitions (Preprocessing_Symbol_Defs'Range) :=
               Preprocessing_Symbol_Defs.all;
@@ -86,6 +90,37 @@ package body Switch.C is
         new String'(Def);
    end Add_Symbol_Definition;
 
+   -----------------------
+   -- Get_Overflow_Mode --
+   -----------------------
+
+   function Get_Overflow_Mode (C : Character) return Overflow_Check_Type is
+   begin
+      case C is
+         when '0' =>
+            return Suppressed;
+
+         when '1' =>
+            return Checked;
+
+         when '2' =>
+            return Minimized;
+
+         --  Eliminated allowed only if Long_Long_Integer is 64 bits (since
+         --  the current implementation of System.Bignums assumes this).
+
+         when '3' =>
+            if Standard_Long_Long_Integer_Size /= 64 then
+               Bad_Switch ("-gnato3 not implemented for this configuration");
+            else
+               return Eliminated;
+            end if;
+
+         when others =>
+            raise Program_Error;
+      end case;
+   end Get_Overflow_Mode;
+
    -----------------------------
    -- Scan_Front_End_Switches --
    -----------------------------
@@ -778,27 +813,8 @@ package body Switch.C is
                else
                   --  Handle first digit after -gnato
 
-                  case Switch_Chars (Ptr) is
-                     when '0' =>
-                        Suppress_Options.Overflow_Checks_General :=
-                          Suppressed;
-
-                     when '1' =>
-                        Suppress_Options.Overflow_Checks_General :=
-                          Checked;
-
-                     when '2' =>
-                        Suppress_Options.Overflow_Checks_General :=
-                          Minimized;
-
-                     when '3' =>
-                        Suppress_Options.Overflow_Checks_General :=
-                          Eliminated;
-
-                     when others =>
-                        raise Program_Error;
-                  end case;
-
+                  Suppress_Options.Overflow_Checks_General :=
+                    Get_Overflow_Mode (Switch_Chars (Ptr));
                   Ptr := Ptr + 1;
 
                   --  Only one digit after -gnato, set assertions mode to
@@ -813,27 +829,8 @@ package body Switch.C is
                   --  Process second digit after -gnato
 
                   else
-                     case Switch_Chars (Ptr) is
-                        when '0' =>
-                           Suppress_Options.Overflow_Checks_Assertions :=
-                             Suppressed;
-
-                        when '1' =>
-                           Suppress_Options.Overflow_Checks_Assertions :=
-                             Checked;
-
-                        when '2' =>
-                           Suppress_Options.Overflow_Checks_Assertions :=
-                             Minimized;
-
-                        when '3' =>
-                           Suppress_Options.Overflow_Checks_Assertions :=
-                             Eliminated;
-
-                        when others =>
-                           raise Program_Error;
-                     end case;
-
+                     Suppress_Options.Overflow_Checks_Assertions :=
+                       Get_Overflow_Mode (Switch_Chars (Ptr));
                      Ptr := Ptr + 1;
                   end if;
                end if;

gcc/ada/switch.ads

@@ -128,6 +128,7 @@ private
 
    procedure Bad_Switch (Switch : Character);
    procedure Bad_Switch (Switch : String);
+   pragma No_Return (Bad_Switch);
    --  Fail with an appropriate message when a switch is not recognized
 
 end Switch;