Commit b9daa96e by Arnaud Charlet

[multiple changes]

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

	* 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  <moy@adacore.com>

	* uintp.adb (UI_Div_Rem): Correct algorithm D to remove potential
	overflow.

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

	* exp_ch4.adb (Expand_N_Op_Mod): Minor comment additions.
	(Expand_N_Op_Rem): Ditto.

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

	* sem_attr.adb: Minor reformatting.

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

	* usage.adb: Update lines for -gnato? switch.

From-SVN: r194202
parent de6cad7c
2012-12-05 Robert Dewar <dewar@adacore.com>
* 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 <moy@adacore.com>
* uintp.adb (UI_Div_Rem): Correct algorithm D to remove potential
overflow.
2012-12-05 Robert Dewar <dewar@adacore.com>
* exp_ch4.adb (Expand_N_Op_Mod): Minor comment additions.
(Expand_N_Op_Rem): Ditto.
2012-12-05 Robert Dewar <dewar@adacore.com>
* sem_attr.adb: Minor reformatting.
2012-12-05 Robert Dewar <dewar@adacore.com>
* usage.adb: Update lines for -gnato? switch.
2012-12-05 Ed Schonberg <schonberg@adacore.com> 2012-12-05 Ed Schonberg <schonberg@adacore.com>
* par-ch6.adb (P_Return_Object_Declaration): Do not check for * par-ch6.adb (P_Return_Object_Declaration): Do not check for
......
...@@ -1931,6 +1931,7 @@ package body Atree is ...@@ -1931,6 +1931,7 @@ package body Atree is
if Is_Syntactic_Field (Nkind (Nod), FN) then if Is_Syntactic_Field (Nkind (Nod), FN) then
declare declare
Elmt : Node_Id := First (List_Id (Fld)); Elmt : Node_Id := First (List_Id (Fld));
begin begin
while Present (Elmt) loop while Present (Elmt) loop
if Traverse_Func (Elmt) = Abandon then if Traverse_Func (Elmt) = Abandon then
......
...@@ -8001,8 +8001,15 @@ package body Exp_Ch4 is ...@@ -8001,8 +8001,15 @@ package body Exp_Ch4 is
end if; end if;
-- Deal with annoying case of largest negative number remainder -- Deal with annoying case of largest negative number remainder
-- minus one. Gigi does not handle this case correctly, because -- minus one. Gigi may not handle this case correctly, because
-- it generates a divide instruction which may trap in this case. -- 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 -- 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 -- the mod value is always 0, and we can just ignore the left operand
...@@ -8674,8 +8681,15 @@ package body Exp_Ch4 is ...@@ -8674,8 +8681,15 @@ package body Exp_Ch4 is
end if; end if;
-- Deal with annoying case of largest negative number remainder minus -- Deal with annoying case of largest negative number remainder minus
-- one. Gigi does not handle this case correctly, because it generates -- one. Gigi may not handle this case correctly, because on some
-- a divide instruction which may trap in this case. -- 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 -- 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 -- the remainder is always 0, and we can just ignore the left operand
......
...@@ -1635,15 +1635,15 @@ package body Exp_Disp is ...@@ -1635,15 +1635,15 @@ package body Exp_Disp is
Formals : constant List_Id := New_List; Formals : constant List_Id := New_List;
Target : constant Entity_Id := Ultimate_Alias (Prim); Target : constant Entity_Id := Ultimate_Alias (Prim);
Decl_1 : Node_Id; Decl_1 : Node_Id;
Decl_2 : Node_Id; Decl_2 : Node_Id;
Expr : Node_Id; Expr : Node_Id;
Formal : Node_Id; Formal : Node_Id;
Ftyp : Entity_Id; Ftyp : Entity_Id;
Iface_Formal : Node_Id; Iface_Formal : Node_Id;
New_Arg : Node_Id; New_Arg : Node_Id;
Offset_To_Top : Node_Id; Offset_To_Top : Node_Id;
Target_Formal : Entity_Id; Target_Formal : Entity_Id;
begin begin
Thunk_Id := Empty; Thunk_Id := Empty;
......
...@@ -1021,6 +1021,10 @@ procedure Gnatchop is ...@@ -1021,6 +1021,10 @@ procedure Gnatchop is
Buffer (Read_Ptr) := EOF; 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 if Read_Ptr = Length then
Contents := Buffer; Contents := Buffer;
......
...@@ -5998,8 +5998,7 @@ package body Sem_Attr is ...@@ -5998,8 +5998,7 @@ package body Sem_Attr is
return return
Is_Floating_Point_Type (Typ) Is_Floating_Point_Type (Typ)
and then and then
(Float_Format = 'V' (Float_Format = 'V' or else Float_Rep (Typ) = VAX_Native);
or else Float_Rep (Typ) = VAX_Native);
end Is_VAX_Float; end Is_VAX_Float;
-------------- --------------
......
...@@ -313,7 +313,7 @@ package Sem_Attr is ...@@ -313,7 +313,7 @@ package Sem_Attr is
-- needed, and the value should never be accessed. -- needed, and the value should never be accessed.
Attribute_Loop_Entry => True, 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 -- 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. -- related loop. The type of the attribute is the type of the prefix.
......
...@@ -5506,6 +5506,12 @@ package body Sem_Ch4 is ...@@ -5506,6 +5506,12 @@ package body Sem_Ch4 is
begin begin
if T1 = Universal_Integer if T1 = Universal_Integer
or else T1 = Universal_Real 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 or else T1 = Any_Access
then then
if not Is_Overloaded (R) then if not Is_Overloaded (R) then
......
...@@ -787,7 +787,6 @@ package body Sem_Ch6 is ...@@ -787,7 +787,6 @@ package body Sem_Ch6 is
Analyze_And_Resolve (Expr, R_Type); Analyze_And_Resolve (Expr, R_Type);
Check_Limited_Return (Expr); Check_Limited_Return (Expr);
end if; end if;
-- RETURN only allowed in SPARK as the last statement in function -- RETURN only allowed in SPARK as the last statement in function
...@@ -808,10 +807,9 @@ package body Sem_Ch6 is ...@@ -808,10 +807,9 @@ package body Sem_Ch6 is
declare declare
Obj_Decl : constant Node_Id := Obj_Decl : constant Node_Id :=
Last (Return_Object_Declarations (N)); Last (Return_Object_Declarations (N));
Has_Aliased : constant Boolean := Aliased_Present (Obj_Decl); 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 begin
Expr := Expression (Obj_Decl); Expr := Expression (Obj_Decl);
......
...@@ -1314,13 +1314,14 @@ package body Sem_Eval is ...@@ -1314,13 +1314,14 @@ package body Sem_Eval is
-- is at optimizing and knowing that things are constant when they are -- is at optimizing and knowing that things are constant when they are
-- nonstatic. -- nonstatic.
-- We make an exception for expressions that evaluate to True/False, to
-- suppress spurious checks in ZFP mode.
if Configurable_Run_Time_Mode if Configurable_Run_Time_Mode
and then K /= N_Null and then K /= N_Null
and then not Is_Static_Expression (Op) and then not Is_Static_Expression (Op)
then 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) if Is_Entity_Name (Op)
and then Ekind (Entity (Op)) = E_Enumeration_Literal and then Ekind (Entity (Op)) = E_Enumeration_Literal
and then Etype (Entity (Op)) = Standard_Boolean and then Etype (Entity (Op)) = Standard_Boolean
......
...@@ -1165,6 +1165,7 @@ package body Uintp is ...@@ -1165,6 +1165,7 @@ package body Uintp is
Divisor_Dig1 : Int; Divisor_Dig1 : Int;
Divisor_Dig2 : Int; Divisor_Dig2 : Int;
Q_Guess : Int; Q_Guess : Int;
R_Guess : Int;
begin begin
-- [ NORMALIZE ] (step D1 in the algorithm). First calculate the -- [ NORMALIZE ] (step D1 in the algorithm). First calculate the
...@@ -1218,30 +1219,26 @@ package body Uintp is ...@@ -1218,30 +1219,26 @@ package body Uintp is
-- Note: this version of step D3 is from the original published -- Note: this version of step D3 is from the original published
-- algorithm, which is known to have a bug causing overflows. -- algorithm, which is known to have a bug causing overflows.
-- See: http://www-cs-faculty.stanford.edu/~uno/err2-2e.ps.gz. -- See: http://www-cs-faculty.stanford.edu/~uno/err2-2e.ps.gz
-- In this code we are safe since our representation of double -- and http://www-cs-faculty.stanford.edu/~uno/all2-pre.ps.gz.
-- length numbers allows an expanded range. -- The code below is the fixed version of this step.
-- 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.
Tmp_Int := Dividend (J) * Base + Dividend (J + 1); Tmp_Int := Dividend (J) * Base + Dividend (J + 1);
-- Initial guess -- Initial guess
if Dividend (J) = Divisor_Dig1 then Q_Guess := Tmp_Int / Divisor_Dig1;
Q_Guess := Base - 1; R_Guess := Tmp_Int rem Divisor_Dig1;
else
Q_Guess := Tmp_Int / Divisor_Dig1;
end if;
-- Refine the guess -- Refine the guess
while Divisor_Dig2 * Q_Guess > while Q_Guess >= Base
(Tmp_Int - Q_Guess * Divisor_Dig1) * Base + or else Divisor_Dig2 * Q_Guess >
Dividend (J + 2) R_Guess * Base + Dividend (J + 2)
loop loop
Q_Guess := Q_Guess - 1; Q_Guess := Q_Guess - 1;
R_Guess := R_Guess + Divisor_Dig1;
exit when R_Guess >= Base;
end loop; end loop;
-- [ MULTIPLY & SUBTRACT ] (step D4). Q_Guess * Divisor is -- [ MULTIPLY & SUBTRACT ] (step D4). Q_Guess * Divisor is
......
...@@ -321,13 +321,14 @@ begin ...@@ -321,13 +321,14 @@ begin
Write_Switch_Char ("o"); Write_Switch_Char ("o");
Write_Line ("Enable overflow checking mode to CHECKED (off by default)"); Write_Line ("Enable overflow checking mode to CHECKED (off by default)");
-- Line for -gnato? switch -- Lines for -gnato? switches
Write_Switch_Char ("o?"); 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_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 -- Line for -gnatO switch
...@@ -366,22 +367,22 @@ begin ...@@ -366,22 +367,22 @@ begin
Write_Switch_Char ("R?s"); Write_Switch_Char ("R?s");
Write_Line ("List rep info to file.rep instead of standard output"); 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_Switch_Char ("s");
Write_Line ("Syntax check only"); Write_Line ("Syntax check only");
-- Lines for -gnatS switch -- Line for -gnatS switch
Write_Switch_Char ("S"); Write_Switch_Char ("S");
Write_Line ("Print listing of package Standard"); Write_Line ("Print listing of package Standard");
-- Lines for -gnatt switch -- Line for -gnatt switch
Write_Switch_Char ("t"); Write_Switch_Char ("t");
Write_Line ("Tree output file to be generated"); Write_Line ("Tree output file to be generated");
-- Line for -gnatT switch -- Line for -gnatTnn switch
Write_Switch_Char ("Tnn"); Write_Switch_Char ("Tnn");
Write_Line ("All compiler tables start at nn times usual starting size"); Write_Line ("All compiler tables start at nn times usual starting size");
...@@ -401,7 +402,7 @@ begin ...@@ -401,7 +402,7 @@ begin
Write_Switch_Char ("v"); Write_Switch_Char ("v");
Write_Line ("Verbose mode. Full error output with source lines to stdout"); 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_Switch_Char ("Vxx");
Write_Line Write_Line
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment