[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
This commit is contained in:
Arnaud Charlet
parent
de6cad7c5c
commit
b9daa96e70
@ -1,3 +1,26 @@
|
||||
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>
|
||||
|
||||
* par-ch6.adb (P_Return_Object_Declaration): Do not check for
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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;
|
||||
|
||||
@ -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;
|
||||
|
||||
|
||||
@ -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;
|
||||
|
||||
--------------
|
||||
|
||||
@ -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.
|
||||
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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);
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user