Patchwork [Ada] Change overflow mode handling

login
register
mail settings
Submitter Arnaud Charlet
Date Dec. 5, 2012, 10:16 a.m.
Message ID <20121205101603.GA29445@adacore.com>
Download mbox | patch
Permalink /patch/203818/
State New
Headers show

Comments

Arnaud Charlet - Dec. 5, 2012, 10:16 a.m.
This patch separates handling of overflow checks and overflow
modes. Internally several names are changed to reflect this.
The externally visible effect is that pragma Overflow_Checks
is changed to Overflow_Mode, CHECKED mode is renamed to STRICT,
and the Overflow_Mode pragma no longer affects overflow checking
mode.

Tested on x86_64-pc-linux-gnu, committed on trunk

2012-12-05  Robert Dewar  <dewar@adacore.com>

	* checks.ads, exp_ch4.adb, gnat1drv.adb, par-prag.adb, sem_prag.adb,
	snames.ads-tmpl, switch-c.adb, types.ads, checks.adb: Change pragma
	Overflow_Checks to Overflow_Mode.
	Separate overflow checking from overflow mode.
	Several name changes to reflect this separation.
	CHECKED mode is renamed STRICT mode.

Patch

Index: switch-c.adb
===================================================================
--- switch-c.adb	(revision 194188)
+++ switch-c.adb	(working copy)
@@ -51,9 +51,9 @@ 
       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;
+   function Get_Overflow_Mode (C : Character) return Overflow_Mode_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.
+   --  Overflow_Mode_Type. Raises Program_Error if C is outside this range.
 
    function Switch_Subsequently_Cancelled
      (C        : String;
@@ -94,7 +94,7 @@ 
    -- Get_Overflow_Mode --
    -----------------------
 
-   function Get_Overflow_Mode (C : Character) return Overflow_Check_Type is
+   function Get_Overflow_Mode (C : Character) return Overflow_Mode_Type is
    begin
       case C is
          when '1' =>
@@ -803,15 +803,15 @@ 
                --  Case of no digits after the -gnato
 
                if Ptr > Max or else Switch_Chars (Ptr) not in '1' .. '3' then
-                  Suppress_Options.Overflow_Checks_General    := Strict;
-                  Suppress_Options.Overflow_Checks_Assertions := Strict;
+                  Suppress_Options.Overflow_Mode_General    := Strict;
+                  Suppress_Options.Overflow_Mode_Assertions := Strict;
 
                --  At least one digit after the -gnato
 
                else
                   --  Handle first digit after -gnato
 
-                  Suppress_Options.Overflow_Checks_General :=
+                  Suppress_Options.Overflow_Mode_General :=
                     Get_Overflow_Mode (Switch_Chars (Ptr));
                   Ptr := Ptr + 1;
 
@@ -821,13 +821,13 @@ 
                   if Ptr > Max
                     or else Switch_Chars (Ptr) not in '1' .. '3'
                   then
-                     Suppress_Options.Overflow_Checks_Assertions :=
-                       Suppress_Options.Overflow_Checks_General;
+                     Suppress_Options.Overflow_Mode_Assertions :=
+                       Suppress_Options.Overflow_Mode_General;
 
                   --  Process second digit after -gnato
 
                   else
-                     Suppress_Options.Overflow_Checks_Assertions :=
+                     Suppress_Options.Overflow_Mode_Assertions :=
                        Get_Overflow_Mode (Switch_Chars (Ptr));
                      Ptr := Ptr + 1;
                   end if;
Index: types.ads
===================================================================
--- types.ads	(revision 194188)
+++ types.ads	(working copy)
@@ -704,14 +704,14 @@ 
    --    5.  Add appropriate checks for the new test
 
    --  The following provides precise details on the mode used to generate
-   --  code for intermediate overflows in expressions for signed integer
+   --  code for intermediate operations in expressions for signed integer
    --  arithmetic (and how to generate overflow checks if enabled). Note
    --  that this only affects handling of intermediate results. The final
    --  result must always fit within the target range, and if overflow
    --  checking is enabled, the check on the final result is against this
    --  target range.
 
-   type Overflow_Check_Type is (
+   type Overflow_Mode_Type is (
       Not_Set,
       --  Dummy value used during initialization process to show that the
       --  corresponding value has not yet been initialized.
@@ -734,9 +734,9 @@ 
       --  the overflow checking mode, since overflows are eliminated.
 
    subtype Minimized_Or_Eliminated is
-     Overflow_Check_Type range Minimized .. Eliminated;
+     Overflow_Mode_Type range Minimized .. Eliminated;
    --  Define subtype so that clients don't need to know ordering. Note that
-   --  Overflow_Check_Type is not marked as an ordered enumeration type.
+   --  Overflow_Mode_Type is not marked as an ordered enumeration type.
 
    --  The following structure captures the state of check suppression or
    --  activation at a particular point in the program execution.
@@ -745,12 +745,12 @@ 
       Suppress : Suppress_Array;
       --  Indicates suppression status of each possible check
 
-      Overflow_Checks_General : Overflow_Check_Type;
+      Overflow_Mode_General : Overflow_Mode_Type;
       --  This field indicates the mode for handling code generation and
       --  overflow checking (if enabled) for intermediate expression values.
       --  This applies to general expressions outside assertions.
 
-      Overflow_Checks_Assertions : Overflow_Check_Type;
+      Overflow_Mode_Assertions : Overflow_Mode_Type;
       --  This field indicates the mode for handling code generation and
       --  overflow checking (if enabled) for intermediate expression values.
       --  This applies to any expression occuring inside assertions.
Index: checks.adb
===================================================================
--- checks.adb	(revision 194188)
+++ checks.adb	(working copy)
@@ -1091,7 +1091,7 @@ 
       Result_Type : constant Entity_Id := Etype (Op);
       --  Original result type
 
-      Check_Mode : constant Overflow_Check_Type := Overflow_Check_Mode;
+      Check_Mode : constant Overflow_Mode_Type := Overflow_Check_Mode;
       pragma Assert (Check_Mode in Minimized_Or_Eliminated);
 
       Lo, Hi : Uint;
@@ -1682,7 +1682,7 @@ 
       Left  : constant Node_Id    := Left_Opnd (N);
       Right : constant Node_Id    := Right_Opnd (N);
 
-      Mode : constant Overflow_Check_Type := Overflow_Check_Mode;
+      Mode : constant Overflow_Mode_Type := Overflow_Check_Mode;
       --  Current overflow checking mode
 
       LLB : Uint;
@@ -4425,7 +4425,7 @@ 
 
    procedure Enable_Overflow_Check (N : Node_Id) is
       Typ  : constant Entity_Id           := Base_Type (Etype (N));
-      Mode : constant Overflow_Check_Type := Overflow_Check_Mode;
+      Mode : constant Overflow_Mode_Type := Overflow_Check_Mode;
       Chk  : Nat;
       OK   : Boolean;
       Ent  : Entity_Id;
@@ -6738,7 +6738,7 @@ 
       pragma Assert (Is_Signed_Integer_Type (Rtyp));
       --  Result type, must be a signed integer type
 
-      Check_Mode : constant Overflow_Check_Type := Overflow_Check_Mode;
+      Check_Mode : constant Overflow_Mode_Type := Overflow_Check_Mode;
       pragma Assert (Check_Mode in Minimized_Or_Eliminated);
 
       Loc : constant Source_Ptr := Sloc (N);
@@ -6848,16 +6848,16 @@ 
       ---------------
 
       procedure Reanalyze (Typ : Entity_Id; Suppress : Boolean := False) is
-         Svg : constant Overflow_Check_Type :=
-                 Scope_Suppress.Overflow_Checks_General;
-         Sva : constant Overflow_Check_Type :=
-                 Scope_Suppress.Overflow_Checks_Assertions;
+         Svg : constant Overflow_Mode_Type :=
+                 Scope_Suppress.Overflow_Mode_General;
+         Sva : constant Overflow_Mode_Type :=
+                 Scope_Suppress.Overflow_Mode_Assertions;
          Svo : constant Boolean             :=
                  Scope_Suppress.Suppress (Overflow_Check);
 
       begin
-         Scope_Suppress.Overflow_Checks_General    := Strict;
-         Scope_Suppress.Overflow_Checks_Assertions := Strict;
+         Scope_Suppress.Overflow_Mode_General    := Strict;
+         Scope_Suppress.Overflow_Mode_Assertions := Strict;
 
          if Suppress then
             Scope_Suppress.Suppress (Overflow_Check) := True;
@@ -6866,8 +6866,8 @@ 
          Analyze_And_Resolve (N, Typ);
 
          Scope_Suppress.Suppress (Overflow_Check)  := Svo;
-         Scope_Suppress.Overflow_Checks_General    := Svg;
-         Scope_Suppress.Overflow_Checks_Assertions := Sva;
+         Scope_Suppress.Overflow_Mode_General    := Svg;
+         Scope_Suppress.Overflow_Mode_Assertions := Sva;
       end Reanalyze;
 
       --------------
@@ -6875,16 +6875,16 @@ 
       --------------
 
       procedure Reexpand (Suppress : Boolean := False) is
-         Svg : constant Overflow_Check_Type :=
-                 Scope_Suppress.Overflow_Checks_General;
-         Sva : constant Overflow_Check_Type :=
-                 Scope_Suppress.Overflow_Checks_Assertions;
+         Svg : constant Overflow_Mode_Type :=
+                 Scope_Suppress.Overflow_Mode_General;
+         Sva : constant Overflow_Mode_Type :=
+                 Scope_Suppress.Overflow_Mode_Assertions;
          Svo : constant Boolean             :=
                  Scope_Suppress.Suppress (Overflow_Check);
 
       begin
-         Scope_Suppress.Overflow_Checks_General    := Strict;
-         Scope_Suppress.Overflow_Checks_Assertions := Strict;
+         Scope_Suppress.Overflow_Mode_General    := Strict;
+         Scope_Suppress.Overflow_Mode_Assertions := Strict;
          Set_Analyzed (N, False);
 
          if Suppress then
@@ -6894,8 +6894,8 @@ 
          Expand (N);
 
          Scope_Suppress.Suppress (Overflow_Check)  := Svo;
-         Scope_Suppress.Overflow_Checks_General    := Svg;
-         Scope_Suppress.Overflow_Checks_Assertions := Sva;
+         Scope_Suppress.Overflow_Mode_General    := Svg;
+         Scope_Suppress.Overflow_Mode_Assertions := Sva;
       end Reexpand;
 
    --  Start of processing for Minimize_Eliminate_Overflows
@@ -7606,14 +7606,14 @@ 
       --  MINIMIZED/ELIMINATED handling, since we are now done with that!
 
       declare
-         SG : constant Overflow_Check_Type :=
-                Scope_Suppress.Overflow_Checks_General;
-         SA : constant Overflow_Check_Type :=
-                Scope_Suppress.Overflow_Checks_Assertions;
+         SG : constant Overflow_Mode_Type :=
+                Scope_Suppress.Overflow_Mode_General;
+         SA : constant Overflow_Mode_Type :=
+                Scope_Suppress.Overflow_Mode_Assertions;
 
       begin
-         Scope_Suppress.Overflow_Checks_General    := Strict;
-         Scope_Suppress.Overflow_Checks_Assertions := Strict;
+         Scope_Suppress.Overflow_Mode_General    := Strict;
+         Scope_Suppress.Overflow_Mode_Assertions := Strict;
 
          if not Do_Overflow_Check (N) then
             Reanalyze (LLIB, Suppress => True);
@@ -7621,8 +7621,8 @@ 
             Reanalyze (LLIB);
          end if;
 
-         Scope_Suppress.Overflow_Checks_General    := SG;
-         Scope_Suppress.Overflow_Checks_Assertions := SA;
+         Scope_Suppress.Overflow_Mode_General    := SG;
+         Scope_Suppress.Overflow_Mode_Assertions := SA;
       end;
    end Minimize_Eliminate_Overflows;
 
@@ -7630,12 +7630,12 @@ 
    -- Overflow_Check_Mode --
    -------------------------
 
-   function Overflow_Check_Mode return Overflow_Check_Type is
+   function Overflow_Check_Mode return Overflow_Mode_Type is
    begin
       if In_Assertion_Expr = 0 then
-         return Scope_Suppress.Overflow_Checks_General;
+         return Scope_Suppress.Overflow_Mode_General;
       else
-         return Scope_Suppress.Overflow_Checks_Assertions;
+         return Scope_Suppress.Overflow_Mode_Assertions;
       end if;
    end Overflow_Check_Mode;
 
Index: checks.ads
===================================================================
--- checks.ads	(revision 194188)
+++ checks.ads	(working copy)
@@ -74,7 +74,7 @@ 
    --  is False, then the status of the check can be determined simply by
    --  examining Scope_Suppress, so this routine is not called in that case.
 
-   function Overflow_Check_Mode return Overflow_Check_Type;
+   function Overflow_Check_Mode return Overflow_Mode_Type;
    --  Returns current overflow checking mode, taking into account whether
    --  we are inside an assertion expression.
 
Index: sem_prag.adb
===================================================================
--- sem_prag.adb	(revision 194188)
+++ sem_prag.adb	(working copy)
@@ -11990,11 +11990,11 @@ 
             Optimize_Alignment_Local := True;
          end Optimize_Alignment;
 
-         ---------------------
-         -- Overflow_Checks --
-         ---------------------
+         -------------------
+         -- Overflow_Mode --
+         -------------------
 
-         --  pragma Overflow_Checks
+         --  pragma Overflow_Mode
          --    ([General => ] MODE [, [Assertions => ] MODE]);
 
          --  MODE := STRICT | MINIMIZED | ELIMINATED
@@ -12003,21 +12003,21 @@ 
          --  since System.Bignums makes this assumption. This is true of nearly
          --  all (all?) targets.
 
-         when Pragma_Overflow_Checks => Overflow_Checks : declare
-            function Get_Check_Mode
+         when Pragma_Overflow_Mode => Overflow_Mode : declare
+            function Get_Overflow_Mode
               (Name : Name_Id;
-               Arg  : Node_Id) return Overflow_Check_Type;
+               Arg  : Node_Id) return Overflow_Mode_Type;
             --  Function to process one pragma argument, Arg. If an identifier
-            --  is present, it must be Name. Check type is returned if a valid
+            --  is present, it must be Name. Mode type is returned if a valid
             --  argument exists, otherwise an error is signalled.
 
-            --------------------
-            -- Get_Check_Mode --
-            --------------------
+            -----------------------
+            -- Get_Overflow_Mode --
+            -----------------------
 
-            function Get_Check_Mode
+            function Get_Overflow_Mode
               (Name : Name_Id;
-               Arg  : Node_Id) return Overflow_Check_Type
+               Arg  : Node_Id) return Overflow_Mode_Type
             is
                Argx : constant Node_Id := Get_Pragma_Arg (Arg);
 
@@ -12042,9 +12042,9 @@ 
                else
                   Error_Pragma_Arg ("invalid argument for pragma%", Argx);
                end if;
-            end Get_Check_Mode;
+            end Get_Overflow_Mode;
 
-         --  Start of processing for Overflow_Checks
+         --  Start of processing for Overflow_Mode
 
          begin
             GNAT_Pragma;
@@ -12053,22 +12053,22 @@ 
 
             --  Process first argument
 
-            Scope_Suppress.Overflow_Checks_General :=
-              Get_Check_Mode (Name_General, Arg1);
+            Scope_Suppress.Overflow_Mode_General :=
+              Get_Overflow_Mode (Name_General, Arg1);
 
             --  Case of only one argument
 
             if Arg_Count = 1 then
-               Scope_Suppress.Overflow_Checks_Assertions :=
-                 Scope_Suppress.Overflow_Checks_General;
+               Scope_Suppress.Overflow_Mode_Assertions :=
+                 Scope_Suppress.Overflow_Mode_General;
 
             --  Case of two arguments present
 
             else
-               Scope_Suppress.Overflow_Checks_Assertions  :=
-                 Get_Check_Mode (Name_Assertions, Arg2);
+               Scope_Suppress.Overflow_Mode_Assertions  :=
+                 Get_Overflow_Mode (Name_Assertions, Arg2);
             end if;
-         end Overflow_Checks;
+         end Overflow_Mode;
 
          -------------
          -- Ordered --
@@ -15541,7 +15541,7 @@ 
       Pragma_Obsolescent                    =>  0,
       Pragma_Optimize                       => -1,
       Pragma_Optimize_Alignment             => -1,
-      Pragma_Overflow_Checks                =>  0,
+      Pragma_Overflow_Mode                  =>  0,
       Pragma_Ordered                        =>  0,
       Pragma_Pack                           =>  0,
       Pragma_Page                           => -1,
Index: gnat1drv.adb
===================================================================
--- gnat1drv.adb	(revision 194191)
+++ gnat1drv.adb	(working copy)
@@ -205,9 +205,9 @@ 
          --  prevents suppressing of overflow checks by default, in code down
          --  below.
 
-         if Suppress_Options.Overflow_Checks_General = Not_Set then
-            Suppress_Options.Overflow_Checks_General    := Strict;
-            Suppress_Options.Overflow_Checks_Assertions := Strict;
+         if Suppress_Options.Overflow_Mode_General = Not_Set then
+            Suppress_Options.Overflow_Mode_General    := Strict;
+            Suppress_Options.Overflow_Mode_Assertions := Strict;
          end if;
 
          --  Kill debug of generated code, since it messes up sloc values
@@ -323,9 +323,9 @@ 
          --  prevents suppressing of overflow checks by default, in code down
          --  below.
 
-         if Suppress_Options.Overflow_Checks_General = Not_Set then
-            Suppress_Options.Overflow_Checks_General    := Strict;
-            Suppress_Options.Overflow_Checks_Assertions := Strict;
+         if Suppress_Options.Overflow_Mode_General = Not_Set then
+            Suppress_Options.Overflow_Mode_General    := Strict;
+            Suppress_Options.Overflow_Mode_Assertions := Strict;
          end if;
 
          --  Kill debug of generated code, since it messes up sloc values
@@ -463,7 +463,7 @@ 
       --  If already set (by -gnato or above in Alfa or CodePeer mode) then we
       --  have nothing to do.
 
-      if Opt.Suppress_Options.Overflow_Checks_General /= Not_Set then
+      if Opt.Suppress_Options.Overflow_Mode_General /= Not_Set then
          null;
 
       --  Otherwise set overflow mode defaults
@@ -480,8 +480,8 @@ 
          --  By default set STRICT mode if -gnatg in effect
 
          if GNAT_Mode then
-            Suppress_Options.Overflow_Checks_General    := Strict;
-            Suppress_Options.Overflow_Checks_Assertions := Strict;
+            Suppress_Options.Overflow_Mode_General    := Strict;
+            Suppress_Options.Overflow_Mode_Assertions := Strict;
 
          --  If we have backend divide and overflow checks, then by default
          --  overflow checks are STRICT. Historically this code used to also
@@ -492,16 +492,16 @@ 
            and
              Targparm.Backend_Overflow_Checks_On_Target
          then
-            Suppress_Options.Overflow_Checks_General    := Strict;
-            Suppress_Options.Overflow_Checks_Assertions := Strict;
+            Suppress_Options.Overflow_Mode_General    := Strict;
+            Suppress_Options.Overflow_Mode_Assertions := Strict;
 
          --  Otherwise for now, default is STRICT mode. This may change in the
          --  future, but for now this is the compatible behavior with previous
          --  versions of GNAT.
 
          else
-            Suppress_Options.Overflow_Checks_General    := Strict;
-            Suppress_Options.Overflow_Checks_Assertions := Strict;
+            Suppress_Options.Overflow_Mode_General    := Strict;
+            Suppress_Options.Overflow_Mode_Assertions := Strict;
          end if;
       end if;
 
Index: exp_ch4.adb
===================================================================
--- exp_ch4.adb	(revision 194188)
+++ exp_ch4.adb	(working copy)
@@ -2274,7 +2274,7 @@ 
       LLIB : constant Entity_Id := Base_Type (Standard_Long_Long_Integer);
       --  Entity for Long_Long_Integer'Base
 
-      Check : constant Overflow_Check_Type := Overflow_Check_Mode;
+      Check : constant Overflow_Mode_Type := Overflow_Check_Mode;
       --  Current overflow checking mode
 
       procedure Set_True;
Index: par-prag.adb
===================================================================
--- par-prag.adb	(revision 194188)
+++ par-prag.adb	(working copy)
@@ -1202,7 +1202,7 @@ 
            Pragma_Ordered                        |
            Pragma_Optimize                       |
            Pragma_Optimize_Alignment             |
-           Pragma_Overflow_Checks                |
+           Pragma_Overflow_Mode                  |
            Pragma_Pack                           |
            Pragma_Partition_Elaboration_Policy   |
            Pragma_Passive                        |
Index: snames.ads-tmpl
===================================================================
--- snames.ads-tmpl	(revision 194188)
+++ snames.ads-tmpl	(working copy)
@@ -410,7 +410,7 @@ 
    Name_No_Strict_Aliasing             : constant Name_Id := N + $; -- GNAT
    Name_Normalize_Scalars              : constant Name_Id := N + $;
    Name_Optimize_Alignment             : constant Name_Id := N + $; -- GNAT
-   Name_Overflow_Checks                : constant Name_Id := N + $; -- GNAT
+   Name_Overflow_Mode                  : constant Name_Id := N + $; -- GNAT
    Name_Partition_Elaboration_Policy   : constant Name_Id := N + $; -- Ada 05
    Name_Persistent_BSS                 : constant Name_Id := N + $; -- GNAT
    Name_Polling                        : constant Name_Id := N + $; -- GNAT
@@ -1690,7 +1690,7 @@ 
       Pragma_No_Strict_Aliasing,
       Pragma_Normalize_Scalars,
       Pragma_Optimize_Alignment,
-      Pragma_Overflow_Checks,
+      Pragma_Overflow_Mode,
       Pragma_Partition_Elaboration_Policy,
       Pragma_Persistent_BSS,
       Pragma_Polling,