From b9daa96e707ca488636eccded3255657ad0ef2bf Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Wed, 5 Dec 2012 11:50:26 +0100 Subject: [PATCH] [multiple changes] 2012-12-05 Robert Dewar * gnatchop.adb, sem_attr.ads, sem_ch4.adb, sem_ch6.adb, exp_disp.adb, atree.adb, sem_eval.adb: Minor reformatting. 2012-12-05 Yannick Moy * uintp.adb (UI_Div_Rem): Correct algorithm D to remove potential overflow. 2012-12-05 Robert Dewar * exp_ch4.adb (Expand_N_Op_Mod): Minor comment additions. (Expand_N_Op_Rem): Ditto. 2012-12-05 Robert Dewar * sem_attr.adb: Minor reformatting. 2012-12-05 Robert Dewar * usage.adb: Update lines for -gnato? switch. From-SVN: r194202 --- gcc/ada/ChangeLog | 23 +++++++++++++++++++++++ gcc/ada/atree.adb | 1 + gcc/ada/exp_ch4.adb | 22 ++++++++++++++++++---- gcc/ada/exp_disp.adb | 18 +++++++++--------- gcc/ada/gnatchop.adb | 4 ++++ gcc/ada/sem_attr.adb | 3 +-- gcc/ada/sem_attr.ads | 2 +- gcc/ada/sem_ch4.adb | 6 ++++++ gcc/ada/sem_ch6.adb | 6 ++---- gcc/ada/sem_eval.adb | 7 ++++--- gcc/ada/uintp.adb | 25 +++++++++++-------------- gcc/ada/usage.adb | 19 ++++++++++--------- 12 files changed, 90 insertions(+), 46 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index b7da722bfc0..1fb42a70c71 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,26 @@ +2012-12-05 Robert Dewar + + * gnatchop.adb, sem_attr.ads, sem_ch4.adb, sem_ch6.adb, exp_disp.adb, + atree.adb, sem_eval.adb: Minor reformatting. + +2012-12-05 Yannick Moy + + * uintp.adb (UI_Div_Rem): Correct algorithm D to remove potential + overflow. + +2012-12-05 Robert Dewar + + * exp_ch4.adb (Expand_N_Op_Mod): Minor comment additions. + (Expand_N_Op_Rem): Ditto. + +2012-12-05 Robert Dewar + + * sem_attr.adb: Minor reformatting. + +2012-12-05 Robert Dewar + + * usage.adb: Update lines for -gnato? switch. + 2012-12-05 Ed Schonberg * par-ch6.adb (P_Return_Object_Declaration): Do not check for diff --git a/gcc/ada/atree.adb b/gcc/ada/atree.adb index 70dd3801e5c..d51e85d300c 100644 --- a/gcc/ada/atree.adb +++ b/gcc/ada/atree.adb @@ -1931,6 +1931,7 @@ package body Atree is if Is_Syntactic_Field (Nkind (Nod), FN) then declare Elmt : Node_Id := First (List_Id (Fld)); + begin while Present (Elmt) loop if Traverse_Func (Elmt) = Abandon then diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index 80c27c4e994..b3701bcdfcb 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -8001,8 +8001,15 @@ package body Exp_Ch4 is end if; -- Deal with annoying case of largest negative number remainder - -- minus one. Gigi does not handle this case correctly, because - -- it generates a divide instruction which may trap in this case. + -- minus one. Gigi may not handle this case correctly, because + -- on some targets, the mod value is computed using a divide + -- instruction which gives an overflow trap for this case. + + -- It would be a bit more efficient to figure out which targets + -- this is really needed for, but in practice it is reasonable + -- to do the following special check in all cases, since it means + -- we get a clearer message, and also the overhead is minimal given + -- that division is expensive in any case. -- In fact the check is quite easy, if the right operand is -1, then -- the mod value is always 0, and we can just ignore the left operand @@ -8674,8 +8681,15 @@ package body Exp_Ch4 is end if; -- Deal with annoying case of largest negative number remainder minus - -- one. Gigi does not handle this case correctly, because it generates - -- a divide instruction which may trap in this case. + -- one. Gigi may not handle this case correctly, because on some + -- targets, the mod value is computed using a divide instruction + -- which gives an overflow trap for this case. + + -- It would be a bit more efficient to figure out which targets this + -- is really needed for, but in practice it is reasonable to do the + -- following special check in all cases, since it means we get a clearer + -- message, and also the overhead is minimal given that division is + -- expensive in any case. -- In fact the check is quite easy, if the right operand is -1, then -- the remainder is always 0, and we can just ignore the left operand diff --git a/gcc/ada/exp_disp.adb b/gcc/ada/exp_disp.adb index 8706b9e6456..23235d8db51 100644 --- a/gcc/ada/exp_disp.adb +++ b/gcc/ada/exp_disp.adb @@ -1635,15 +1635,15 @@ package body Exp_Disp is Formals : constant List_Id := New_List; Target : constant Entity_Id := Ultimate_Alias (Prim); - Decl_1 : Node_Id; - Decl_2 : Node_Id; - Expr : Node_Id; - Formal : Node_Id; - Ftyp : Entity_Id; - Iface_Formal : Node_Id; - New_Arg : Node_Id; - Offset_To_Top : Node_Id; - Target_Formal : Entity_Id; + Decl_1 : Node_Id; + Decl_2 : Node_Id; + Expr : Node_Id; + Formal : Node_Id; + Ftyp : Entity_Id; + Iface_Formal : Node_Id; + New_Arg : Node_Id; + Offset_To_Top : Node_Id; + Target_Formal : Entity_Id; begin Thunk_Id := Empty; diff --git a/gcc/ada/gnatchop.adb b/gcc/ada/gnatchop.adb index 0969c53135c..82b944b78c5 100644 --- a/gcc/ada/gnatchop.adb +++ b/gcc/ada/gnatchop.adb @@ -1021,6 +1021,10 @@ procedure Gnatchop is Buffer (Read_Ptr) := EOF; + -- Comment needed for the following ??? + -- Under what circumstances can the test fail ??? + -- What is copy doing in that case??? + if Read_Ptr = Length then Contents := Buffer; diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index 773b50205e6..b68b5937c38 100644 --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -5998,8 +5998,7 @@ package body Sem_Attr is return Is_Floating_Point_Type (Typ) and then - (Float_Format = 'V' - or else Float_Rep (Typ) = VAX_Native); + (Float_Format = 'V' or else Float_Rep (Typ) = VAX_Native); end Is_VAX_Float; -------------- diff --git a/gcc/ada/sem_attr.ads b/gcc/ada/sem_attr.ads index b993b9bab82..7583ab434f4 100644 --- a/gcc/ada/sem_attr.ads +++ b/gcc/ada/sem_attr.ads @@ -313,7 +313,7 @@ package Sem_Attr is -- needed, and the value should never be accessed. Attribute_Loop_Entry => True, - -- For every object of a non-limited type, S'Loop_Entry { (Loop_Name) } + -- For every object of a non-limited type, S'Loop_Entry [(Loop_Name)] -- denotes the constant value of prefix S at the point of entry into the -- related loop. The type of the attribute is the type of the prefix. diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb index 2c54fcdc5c8..55051417c89 100644 --- a/gcc/ada/sem_ch4.adb +++ b/gcc/ada/sem_ch4.adb @@ -5506,6 +5506,12 @@ package body Sem_Ch4 is begin if T1 = Universal_Integer or else T1 = Universal_Real + + -- If the left operand of an equality operator is null, the visibility + -- of the operator must be determined from the interpretation of the + -- right operand. This processing must be done for Any_Access, which + -- is the internal representation of the type of the literal null. + or else T1 = Any_Access then if not Is_Overloaded (R) then diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index cfa709cd9d2..2903e896e5e 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -787,7 +787,6 @@ package body Sem_Ch6 is Analyze_And_Resolve (Expr, R_Type); Check_Limited_Return (Expr); - end if; -- RETURN only allowed in SPARK as the last statement in function @@ -808,10 +807,9 @@ package body Sem_Ch6 is declare Obj_Decl : constant Node_Id := - Last (Return_Object_Declarations (N)); + Last (Return_Object_Declarations (N)); Has_Aliased : constant Boolean := Aliased_Present (Obj_Decl); - - HSS : constant Node_Id := Handled_Statement_Sequence (N); + HSS : constant Node_Id := Handled_Statement_Sequence (N); begin Expr := Expression (Obj_Decl); diff --git a/gcc/ada/sem_eval.adb b/gcc/ada/sem_eval.adb index 4a8fa2c627f..a4bb76e309b 100644 --- a/gcc/ada/sem_eval.adb +++ b/gcc/ada/sem_eval.adb @@ -1314,13 +1314,14 @@ package body Sem_Eval is -- is at optimizing and knowing that things are constant when they are -- nonstatic. - -- We make an exception for expressions that evaluate to True/False, to - -- suppress spurious checks in ZFP mode. - if Configurable_Run_Time_Mode and then K /= N_Null and then not Is_Static_Expression (Op) then + -- We make an exception for expressions that evaluate to True/False, + -- to suppress spurious checks in ZFP mode. So far we have not seen + -- any negative consequences of this exception. + if Is_Entity_Name (Op) and then Ekind (Entity (Op)) = E_Enumeration_Literal and then Etype (Entity (Op)) = Standard_Boolean diff --git a/gcc/ada/uintp.adb b/gcc/ada/uintp.adb index 0761f2df70b..bc014666224 100644 --- a/gcc/ada/uintp.adb +++ b/gcc/ada/uintp.adb @@ -1165,6 +1165,7 @@ package body Uintp is Divisor_Dig1 : Int; Divisor_Dig2 : Int; Q_Guess : Int; + R_Guess : Int; begin -- [ NORMALIZE ] (step D1 in the algorithm). First calculate the @@ -1218,30 +1219,26 @@ package body Uintp is -- Note: this version of step D3 is from the original published -- algorithm, which is known to have a bug causing overflows. - -- See: http://www-cs-faculty.stanford.edu/~uno/err2-2e.ps.gz. - -- In this code we are safe since our representation of double - -- length numbers allows an expanded range. - - -- We don't have a proof of this claim, but the only cases we - -- have found that show the bug in step D3 work fine here. + -- See: http://www-cs-faculty.stanford.edu/~uno/err2-2e.ps.gz + -- and http://www-cs-faculty.stanford.edu/~uno/all2-pre.ps.gz. + -- The code below is the fixed version of this step. Tmp_Int := Dividend (J) * Base + Dividend (J + 1); -- Initial guess - if Dividend (J) = Divisor_Dig1 then - Q_Guess := Base - 1; - else - Q_Guess := Tmp_Int / Divisor_Dig1; - end if; + Q_Guess := Tmp_Int / Divisor_Dig1; + R_Guess := Tmp_Int rem Divisor_Dig1; -- Refine the guess - while Divisor_Dig2 * Q_Guess > - (Tmp_Int - Q_Guess * Divisor_Dig1) * Base + - Dividend (J + 2) + while Q_Guess >= Base + or else Divisor_Dig2 * Q_Guess > + R_Guess * Base + Dividend (J + 2) loop Q_Guess := Q_Guess - 1; + R_Guess := R_Guess + Divisor_Dig1; + exit when R_Guess >= Base; end loop; -- [ MULTIPLY & SUBTRACT ] (step D4). Q_Guess * Divisor is diff --git a/gcc/ada/usage.adb b/gcc/ada/usage.adb index 7c9c4023bbe..c492ecfea65 100644 --- a/gcc/ada/usage.adb +++ b/gcc/ada/usage.adb @@ -321,13 +321,14 @@ begin Write_Switch_Char ("o"); Write_Line ("Enable overflow checking mode to CHECKED (off by default)"); - -- Line for -gnato? switch + -- Lines for -gnato? switches Write_Switch_Char ("o?"); - Write_Line ("Set SUPPRESSED/CHECKED/MINIMIZED/ELIMINATED (?=0/1/2/3) mode"); - + Write_Line + ("Enable overflow checks in STRICT/MINIMIZED/ELIMINATED (1/2/3) mode "); Write_Switch_Char ("o??"); - Write_Line ("Set mode for general/assertion expressions separately"); + Write_Line + ("Set mode for general/assertion expressions separately"); -- Line for -gnatO switch @@ -366,22 +367,22 @@ begin Write_Switch_Char ("R?s"); Write_Line ("List rep info to file.rep instead of standard output"); - -- Lines for -gnats switch + -- Line for -gnats switch Write_Switch_Char ("s"); Write_Line ("Syntax check only"); - -- Lines for -gnatS switch + -- Line for -gnatS switch Write_Switch_Char ("S"); Write_Line ("Print listing of package Standard"); - -- Lines for -gnatt switch + -- Line for -gnatt switch Write_Switch_Char ("t"); Write_Line ("Tree output file to be generated"); - -- Line for -gnatT switch + -- Line for -gnatTnn switch Write_Switch_Char ("Tnn"); Write_Line ("All compiler tables start at nn times usual starting size"); @@ -401,7 +402,7 @@ begin Write_Switch_Char ("v"); Write_Line ("Verbose mode. Full error output with source lines to stdout"); - -- Line for -gnatV switch + -- Lines for -gnatV switch Write_Switch_Char ("Vxx"); Write_Line