mirror of git://gcc.gnu.org/git/gcc.git
[multiple changes]
2012-10-01 Robert Dewar <dewar@adacore.com> * checks.adb (Apply_Divide_Checks): New name for Apply_Divide_Check (Minimize_Eliminate_Overflow_Checks): Add code to handle division (and rem and mod) properly. (Apply_Division_Check): New procedure (Apply_Divide_Checks): Use Apply_Division_Check (Apply_Divide_Checks): Use Apply_Arithmetic_Overflow_Minimized_Eliminated. * checks.ads (Apply_Divide_Checks): New name for Apply_Divide_Check, also add clearer documentation for this routine and put in alfa order. * exp_ch4.adb (Apply_Divide_Checks): New name for Apply_Divide_Check. * s-bignum.adb (To_Bignum): Handle largest negative integer properly. * sem.adb (Analyze): Handle overflow suppression correctly (Analyze_List): Handle overflow suppression correctly * sem_res.adb (Analyze_And_Resolve): Handle overflow suppression correctly. 2012-10-01 Vasiliy Fofanov <fofanov@adacore.com> * s-oscons-tmplt.c, g-socket.ads: Revert previous change, breaks VMS. From-SVN: r191920
This commit is contained in:
Arnaud Charlet
parent
6cb3037c69
commit
a91e9ac73d
|
|
@ -1,3 +1,27 @@
|
|||
2012-10-01 Robert Dewar <dewar@adacore.com>
|
||||
|
||||
* checks.adb (Apply_Divide_Checks): New name for
|
||||
Apply_Divide_Check (Minimize_Eliminate_Overflow_Checks):
|
||||
Add code to handle division (and rem and mod) properly.
|
||||
(Apply_Division_Check): New procedure (Apply_Divide_Checks):
|
||||
Use Apply_Division_Check (Apply_Divide_Checks): Use
|
||||
Apply_Arithmetic_Overflow_Minimized_Eliminated.
|
||||
* checks.ads (Apply_Divide_Checks): New name for
|
||||
Apply_Divide_Check, also add clearer documentation for this
|
||||
routine and put in alfa order.
|
||||
* exp_ch4.adb (Apply_Divide_Checks): New name for
|
||||
Apply_Divide_Check.
|
||||
* s-bignum.adb (To_Bignum): Handle largest negative integer
|
||||
properly.
|
||||
* sem.adb (Analyze): Handle overflow suppression correctly
|
||||
(Analyze_List): Handle overflow suppression correctly
|
||||
* sem_res.adb (Analyze_And_Resolve): Handle overflow suppression
|
||||
correctly.
|
||||
|
||||
2012-10-01 Vasiliy Fofanov <fofanov@adacore.com>
|
||||
|
||||
* s-oscons-tmplt.c, g-socket.ads: Revert previous change, breaks VMS.
|
||||
|
||||
2012-10-01 Robert Dewar <dewar@adacore.com>
|
||||
|
||||
* checks.adb (Minimize_Eliminate_Overflow_Checks): Changes
|
||||
|
|
|
|||
|
|
@ -193,14 +193,6 @@ package body Checks is
|
|||
-- Local Subprograms --
|
||||
-----------------------
|
||||
|
||||
procedure Apply_Float_Conversion_Check
|
||||
(Ck_Node : Node_Id;
|
||||
Target_Typ : Entity_Id);
|
||||
-- The checks on a conversion from a floating-point type to an integer
|
||||
-- type are delicate. They have to be performed before conversion, they
|
||||
-- have to raise an exception when the operand is a NaN, and rounding must
|
||||
-- be taken into account to determine the safe bounds of the operand.
|
||||
|
||||
procedure Apply_Arithmetic_Overflow_Normal (N : Node_Id);
|
||||
-- Used to apply arithmetic overflow checks for all cases except operators
|
||||
-- on signed arithmetic types in Minimized/Eliminate case (for which we
|
||||
|
|
@ -211,6 +203,24 @@ package body Checks is
|
|||
-- checking mode is Minimized or Eliminated (and the Do_Overflow_Check flag
|
||||
-- is known to be set) and we have an signed integer arithmetic op.
|
||||
|
||||
procedure Apply_Division_Check
|
||||
(N : Node_Id;
|
||||
Rlo : Uint;
|
||||
Rhi : Uint;
|
||||
ROK : Boolean);
|
||||
-- N is an N_Op_Div, N_Op_Rem, or N_Op_Mod node. This routine applies
|
||||
-- division checks as required if the Do_Division_Check flag is set.
|
||||
-- Rlo and Rhi give the possible range of the right operand, these values
|
||||
-- can be referenced and trusted only if ROK is set True.
|
||||
|
||||
procedure Apply_Float_Conversion_Check
|
||||
(Ck_Node : Node_Id;
|
||||
Target_Typ : Entity_Id);
|
||||
-- The checks on a conversion from a floating-point type to an integer
|
||||
-- type are delicate. They have to be performed before conversion, they
|
||||
-- have to raise an exception when the operand is a NaN, and rounding must
|
||||
-- be taken into account to determine the safe bounds of the operand.
|
||||
|
||||
procedure Apply_Selected_Length_Checks
|
||||
(Ck_Node : Node_Id;
|
||||
Target_Typ : Entity_Id;
|
||||
|
|
@ -1641,36 +1651,124 @@ package body Checks is
|
|||
Reason => CE_Discriminant_Check_Failed));
|
||||
end Apply_Discriminant_Check;
|
||||
|
||||
------------------------
|
||||
-- Apply_Divide_Check --
|
||||
------------------------
|
||||
-------------------------
|
||||
-- Apply_Divide_Checks --
|
||||
-------------------------
|
||||
|
||||
procedure Apply_Divide_Check (N : Node_Id) is
|
||||
procedure Apply_Divide_Checks (N : Node_Id) is
|
||||
Loc : constant Source_Ptr := Sloc (N);
|
||||
Typ : constant Entity_Id := Etype (N);
|
||||
Left : constant Node_Id := Left_Opnd (N);
|
||||
Right : constant Node_Id := Right_Opnd (N);
|
||||
|
||||
Mode : constant Overflow_Check_Type := Overflow_Check_Mode (Typ);
|
||||
-- Current overflow checking mode
|
||||
|
||||
LLB : Uint;
|
||||
Llo : Uint;
|
||||
Lhi : Uint;
|
||||
LOK : Boolean;
|
||||
Rlo : Uint;
|
||||
Rhi : Uint;
|
||||
ROK : Boolean;
|
||||
ROK : Boolean;
|
||||
|
||||
pragma Warnings (Off, Lhi);
|
||||
-- Don't actually use this value
|
||||
|
||||
begin
|
||||
-- If we are operating in MINIMIZED or ELIMINATED mode, and the
|
||||
-- Do_Overflow_Check flag is set and we are operating on signed
|
||||
-- integer types, then the only thing this routine does is to call
|
||||
-- Apply_Arithmetic_Overflow_Minimized_Eliminated. That procedure will
|
||||
-- (possibly later on during recursive downward calls), make sure that
|
||||
-- any needed overflow and division checks are properly applied.
|
||||
|
||||
if Mode in Minimized_Or_Eliminated
|
||||
and then Do_Overflow_Check (N)
|
||||
and then Is_Signed_Integer_Type (Typ)
|
||||
then
|
||||
Apply_Arithmetic_Overflow_Minimized_Eliminated (N);
|
||||
return;
|
||||
end if;
|
||||
|
||||
-- Proceed here in SUPPRESSED or CHECKED modes
|
||||
|
||||
if Full_Expander_Active
|
||||
and then not Backend_Divide_Checks_On_Target
|
||||
and then Check_Needed (Right, Division_Check)
|
||||
then
|
||||
Determine_Range (Right, ROK, Rlo, Rhi, Assume_Valid => True);
|
||||
|
||||
-- Deal with division check
|
||||
|
||||
if Do_Division_Check (N)
|
||||
and then not Division_Checks_Suppressed (Typ)
|
||||
then
|
||||
Apply_Division_Check (N, Rlo, Rhi, ROK);
|
||||
end if;
|
||||
|
||||
-- Deal with overflow check
|
||||
|
||||
if Do_Overflow_Check (N) and then Mode /= Suppressed then
|
||||
|
||||
-- Test for extremely annoying case of xxx'First divided by -1
|
||||
-- for division of signed integer types (only overflow case).
|
||||
|
||||
if Nkind (N) = N_Op_Divide
|
||||
and then Is_Signed_Integer_Type (Typ)
|
||||
then
|
||||
Determine_Range (Left, LOK, Llo, Lhi, Assume_Valid => True);
|
||||
LLB := Expr_Value (Type_Low_Bound (Base_Type (Typ)));
|
||||
|
||||
if ((not ROK) or else (Rlo <= (-1) and then (-1) <= Rhi))
|
||||
and then
|
||||
((not LOK) or else (Llo = LLB))
|
||||
then
|
||||
Insert_Action (N,
|
||||
Make_Raise_Constraint_Error (Loc,
|
||||
Condition =>
|
||||
Make_And_Then (Loc,
|
||||
Left_Opnd =>
|
||||
Make_Op_Eq (Loc,
|
||||
Left_Opnd =>
|
||||
Duplicate_Subexpr_Move_Checks (Left),
|
||||
Right_Opnd => Make_Integer_Literal (Loc, LLB)),
|
||||
|
||||
Right_Opnd =>
|
||||
Make_Op_Eq (Loc,
|
||||
Left_Opnd => Duplicate_Subexpr (Right),
|
||||
Right_Opnd => Make_Integer_Literal (Loc, -1))),
|
||||
|
||||
Reason => CE_Overflow_Check_Failed));
|
||||
end if;
|
||||
end if;
|
||||
end if;
|
||||
end if;
|
||||
end Apply_Divide_Checks;
|
||||
|
||||
--------------------------
|
||||
-- Apply_Division_Check --
|
||||
--------------------------
|
||||
|
||||
procedure Apply_Division_Check
|
||||
(N : Node_Id;
|
||||
Rlo : Uint;
|
||||
Rhi : Uint;
|
||||
ROK : Boolean)
|
||||
is
|
||||
pragma Assert (Do_Division_Check (N));
|
||||
|
||||
Loc : constant Source_Ptr := Sloc (N);
|
||||
Right : constant Node_Id := Right_Opnd (N);
|
||||
|
||||
begin
|
||||
if Full_Expander_Active
|
||||
and then not Backend_Divide_Checks_On_Target
|
||||
and then Check_Needed (Right, Division_Check)
|
||||
then
|
||||
-- See if division by zero possible, and if so generate test. This
|
||||
-- part of the test is not controlled by the -gnato switch.
|
||||
-- part of the test is not controlled by the -gnato switch, since
|
||||
-- it is a Division_Check and not an Overflow_Check.
|
||||
|
||||
if Do_Division_Check (N) then
|
||||
if (not ROK) or else (Rlo <= 0 and then 0 <= Rhi) then
|
||||
|
|
@ -1683,41 +1781,8 @@ package body Checks is
|
|||
Reason => CE_Divide_By_Zero));
|
||||
end if;
|
||||
end if;
|
||||
|
||||
-- Test for extremely annoying case of xxx'First divided by -1
|
||||
|
||||
if Do_Overflow_Check (N) then
|
||||
if Nkind (N) = N_Op_Divide
|
||||
and then Is_Signed_Integer_Type (Typ)
|
||||
then
|
||||
Determine_Range (Left, LOK, Llo, Lhi, Assume_Valid => True);
|
||||
LLB := Expr_Value (Type_Low_Bound (Base_Type (Typ)));
|
||||
|
||||
if ((not ROK) or else (Rlo <= (-1) and then (-1) <= Rhi))
|
||||
and then
|
||||
((not LOK) or else (Llo = LLB))
|
||||
then
|
||||
Insert_Action (N,
|
||||
Make_Raise_Constraint_Error (Loc,
|
||||
Condition =>
|
||||
Make_And_Then (Loc,
|
||||
|
||||
Make_Op_Eq (Loc,
|
||||
Left_Opnd =>
|
||||
Duplicate_Subexpr_Move_Checks (Left),
|
||||
Right_Opnd => Make_Integer_Literal (Loc, LLB)),
|
||||
|
||||
Make_Op_Eq (Loc,
|
||||
Left_Opnd =>
|
||||
Duplicate_Subexpr (Right),
|
||||
Right_Opnd =>
|
||||
Make_Integer_Literal (Loc, -1))),
|
||||
Reason => CE_Overflow_Check_Failed));
|
||||
end if;
|
||||
end if;
|
||||
end if;
|
||||
end if;
|
||||
end Apply_Divide_Check;
|
||||
end Apply_Division_Check;
|
||||
|
||||
----------------------------------
|
||||
-- Apply_Float_Conversion_Check --
|
||||
|
|
@ -6496,6 +6561,36 @@ package body Checks is
|
|||
OK : Boolean;
|
||||
-- Used in call to Determine_Range
|
||||
|
||||
procedure Max (A : in out Uint; B : Uint);
|
||||
-- If A is No_Uint, sets A to B, else to UI_Max (A, B);
|
||||
|
||||
procedure Min (A : in out Uint; B : Uint);
|
||||
-- If A is No_Uint, sets A to B, else to UI_Min (A, B);
|
||||
|
||||
---------
|
||||
-- Max --
|
||||
---------
|
||||
|
||||
procedure Max (A : in out Uint; B : Uint) is
|
||||
begin
|
||||
if A = No_Uint or else B > A then
|
||||
A := B;
|
||||
end if;
|
||||
end Max;
|
||||
|
||||
---------
|
||||
-- Min --
|
||||
---------
|
||||
|
||||
procedure Min (A : in out Uint; B : Uint) is
|
||||
begin
|
||||
if A = No_Uint or else B < A then
|
||||
A := B;
|
||||
end if;
|
||||
end Min;
|
||||
|
||||
-- Start of processing for Minimize_Eliminate_Overflow_Checks
|
||||
|
||||
begin
|
||||
-- Case where we do not have an arithmetic operator.
|
||||
|
||||
|
|
@ -6559,7 +6654,148 @@ package body Checks is
|
|||
-- Division
|
||||
|
||||
when N_Op_Divide =>
|
||||
raise Program_Error;
|
||||
|
||||
-- Following seems awfully complex, can it be simplified ???
|
||||
|
||||
Hi := No_Uint;
|
||||
Lo := No_Uint;
|
||||
|
||||
declare
|
||||
S : Uint;
|
||||
|
||||
begin
|
||||
-- First work on finding big absolute result values. These
|
||||
-- come from dividing large numbers (which we have in Llo
|
||||
-- and Lhi) by small values, which we need to figure out.
|
||||
|
||||
-- Case where right operand can be positive
|
||||
|
||||
if Rhi > 0 then
|
||||
|
||||
-- Find smallest positive divisor
|
||||
|
||||
if Rlo > 0 then
|
||||
S := Rlo;
|
||||
else
|
||||
S := Uint_1;
|
||||
end if;
|
||||
|
||||
-- Big negative value divided by small positive value
|
||||
-- generates a candidate for lowest possible result.
|
||||
|
||||
if Llo < 0 then
|
||||
Min (Lo, Llo / S);
|
||||
end if;
|
||||
|
||||
-- Big positive value divided by small positive value
|
||||
-- generates a candidate for highest possible result.
|
||||
|
||||
if Lhi > 0 then
|
||||
Max (Hi, Lhi / S);
|
||||
end if;
|
||||
end if;
|
||||
|
||||
-- Case where right operand can be negative
|
||||
|
||||
if Rlo < 0 then
|
||||
|
||||
-- Find smallest absolute value negative divisor
|
||||
|
||||
if Rhi < 0 then
|
||||
S := Rhi;
|
||||
else
|
||||
S := -Uint_1;
|
||||
end if;
|
||||
|
||||
-- Big negative value divided by small negative value
|
||||
-- generates a candidate for largest possible result.
|
||||
|
||||
if Llo < 0 then
|
||||
Max (Hi, Llo / S);
|
||||
end if;
|
||||
|
||||
-- Big positive value divided by small negative value
|
||||
-- generates a candidate for lowest possible result.
|
||||
|
||||
if Lhi > 0 then
|
||||
Min (Lo, Lhi / S);
|
||||
end if;
|
||||
end if;
|
||||
|
||||
-- Now work on finding small absolute result values. These
|
||||
-- come from dividing small numbers, which we need to figure
|
||||
-- out, by large values (which we have in Rlo, Rhi).
|
||||
|
||||
-- Case where left operand can be positive
|
||||
|
||||
if Lhi > 0 then
|
||||
|
||||
-- Find smallest positive dividend
|
||||
|
||||
if Llo > 0 then
|
||||
S := Llo;
|
||||
else
|
||||
S := Uint_1;
|
||||
end if;
|
||||
|
||||
-- Small positive values divided by large negative values
|
||||
-- generate candidates for low results.
|
||||
|
||||
if Rlo < 0 then
|
||||
Min (Lo, S / Rlo);
|
||||
end if;
|
||||
|
||||
-- Small positive values divided by large positive values
|
||||
-- generate candidates for high results.
|
||||
|
||||
if Rhi > 0 then
|
||||
Max (Hi, S / Rhi);
|
||||
end if;
|
||||
end if;
|
||||
|
||||
-- Case where left operand can be negative
|
||||
|
||||
if Llo < 0 then
|
||||
|
||||
-- Find smallest absolute value negative dividend
|
||||
|
||||
if Lhi < 0 then
|
||||
S := Lhi;
|
||||
else
|
||||
S := -Uint_1;
|
||||
end if;
|
||||
|
||||
-- Small negative value divided by large negative value
|
||||
-- generates a candidate for highest possible result.
|
||||
|
||||
if Rlo < 0 then
|
||||
Max (Hi, Rlo / S);
|
||||
end if;
|
||||
|
||||
-- Small negative value divided by large positive value
|
||||
-- generates a candidate for lowest possible result.
|
||||
|
||||
if Rhi > 0 then
|
||||
Min (Lo, Rhi / S);
|
||||
end if;
|
||||
end if;
|
||||
|
||||
-- Finally, if neither Lo or Hi set (happens if the right
|
||||
-- operand is always zero for example), then set 0 .. 0.
|
||||
|
||||
if Lo = No_Uint and then Hi = No_Uint then
|
||||
Lo := Uint_0;
|
||||
Hi := Uint_0;
|
||||
|
||||
-- If one bound set and not the other copy
|
||||
|
||||
elsif Lo = No_Uint then
|
||||
Lo := Hi;
|
||||
|
||||
elsif Hi = No_Uint then
|
||||
Hi := Lo;
|
||||
end if;
|
||||
end;
|
||||
|
||||
-- Exponentiation
|
||||
|
||||
|
|
@ -6647,7 +6883,26 @@ package body Checks is
|
|||
-- Mod
|
||||
|
||||
when N_Op_Mod =>
|
||||
raise Program_Error;
|
||||
declare
|
||||
Maxabs : constant Uint := UI_Max (abs Rlo, abs Rhi);
|
||||
-- This is the maximum absolute value of the result
|
||||
|
||||
begin
|
||||
Lo := Uint_0;
|
||||
Hi := Uint_0;
|
||||
|
||||
-- The result depends only on the sign and magnitude of
|
||||
-- the right operand, it does not depend on the sign or
|
||||
-- magnitude of the left operand.
|
||||
|
||||
if Rlo < 0 then
|
||||
Lo := -Maxabs;
|
||||
end if;
|
||||
|
||||
if Rhi > 0 then
|
||||
Hi := Maxabs;
|
||||
end if;
|
||||
end;
|
||||
|
||||
-- Multiplication
|
||||
|
||||
|
|
@ -6683,7 +6938,29 @@ package body Checks is
|
|||
-- Remainder
|
||||
|
||||
when N_Op_Rem =>
|
||||
raise Program_Error;
|
||||
declare
|
||||
Maxabs : constant Uint := UI_Max (abs Rlo, abs Rhi);
|
||||
-- This is the maximum absolute value of the result. Note
|
||||
-- that the result range does not depend on the sign of B.
|
||||
|
||||
begin
|
||||
Lo := Uint_0;
|
||||
Hi := Uint_0;
|
||||
|
||||
-- Case of left operand negative, which results in a range
|
||||
-- of -Maxabs .. 0 for those negative values. If there are
|
||||
-- no negative values then Lo value of result is always 0.
|
||||
|
||||
if Llo < 0 then
|
||||
Lo := -Maxabs;
|
||||
end if;
|
||||
|
||||
-- Case of left operand positive
|
||||
|
||||
if Lhi > 0 then
|
||||
Hi := Maxabs;
|
||||
end if;
|
||||
end;
|
||||
|
||||
-- Subtract
|
||||
|
||||
|
|
@ -6819,16 +7096,21 @@ package body Checks is
|
|||
Set_Etype (N, Empty);
|
||||
Set_Entity (N, Empty);
|
||||
|
||||
-- Now analyze this new node
|
||||
-- Now analyze this new node. This reanalysis will complete processing
|
||||
-- for the node. In particular we will complete the expansion of an
|
||||
-- exponentiation operator (e.g. changing A ** 2 to A * A), and also
|
||||
-- we will complete any division checks (since we have not changed the
|
||||
-- setting of the Do_Division_Check flag).
|
||||
|
||||
-- If no overflow check, suppress all checks
|
||||
-- If no overflow check, suppress overflow check to avoid an infinite
|
||||
-- recursion into this procedure.
|
||||
|
||||
if not Do_Overflow_Check (N) then
|
||||
Analyze_And_Resolve (N, LLIB, Suppress => All_Checks);
|
||||
Analyze_And_Resolve (N, LLIB, Suppress => Overflow_Check);
|
||||
|
||||
-- If an overflow check is required, do it in normal CHECKED mode.
|
||||
-- That avoids an infinite recursion, makes sure we get a normal
|
||||
-- overflow check, and also completes expansion of Exponentiation.
|
||||
-- That avoids an infinite recursion, making sure we get a normal
|
||||
-- overflow check.
|
||||
|
||||
else
|
||||
declare
|
||||
|
|
|
|||
|
|
@ -166,6 +166,13 @@ package Checks is
|
|||
-- formals, the check is performed only if the corresponding actual is
|
||||
-- constrained, i.e., whether Lhs'Constrained is True.
|
||||
|
||||
procedure Apply_Divide_Checks (N : Node_Id);
|
||||
-- The node kind is N_Op_Divide, N_Op_Mod, or N_Op_Rem if either of the
|
||||
-- flags Do_Division_Check or Do_Overflow_Check is set, then this routine
|
||||
-- ensures that the appropriate checks are made. Note that overflow can
|
||||
-- occur in the signed case for the case of the largest negative number
|
||||
-- divided by minus one.
|
||||
|
||||
procedure Apply_Parameter_Aliasing_And_Validity_Checks (Subp : Entity_Id);
|
||||
-- Given a subprogram Subp, add both a pre and post condition pragmas that
|
||||
-- detect aliased objects and verify the proper initialization of scalars
|
||||
|
|
@ -176,12 +183,6 @@ package Checks is
|
|||
-- for Typ, if Typ has a predicate function. The check is applied only
|
||||
-- if the type of N does not match Typ.
|
||||
|
||||
procedure Apply_Divide_Check (N : Node_Id);
|
||||
-- The node kind is N_Op_Divide, N_Op_Mod, or N_Op_Rem. An appropriate
|
||||
-- check is generated to ensure that the right operand is non-zero. In
|
||||
-- the divide case, we also check that we do not have the annoying case
|
||||
-- of the largest negative number divided by minus one.
|
||||
|
||||
procedure Apply_Type_Conversion_Checks (N : Node_Id);
|
||||
-- N is an N_Type_Conversion node. A type conversion actually involves
|
||||
-- two sorts of checks. The first check is the checks that ensures that
|
||||
|
|
|
|||
|
|
@ -6584,7 +6584,7 @@ package body Exp_Ch4 is
|
|||
-- Non-fixed point cases, do integer zero divide and overflow checks
|
||||
|
||||
elsif Is_Integer_Type (Typ) then
|
||||
Apply_Divide_Check (N);
|
||||
Apply_Divide_Checks (N);
|
||||
|
||||
-- Deal with Vax_Float
|
||||
|
||||
|
|
@ -7836,7 +7836,7 @@ package body Exp_Ch4 is
|
|||
|
||||
else
|
||||
if Is_Integer_Type (Etype (N)) then
|
||||
Apply_Divide_Check (N);
|
||||
Apply_Divide_Checks (N);
|
||||
end if;
|
||||
|
||||
-- Apply optimization x mod 1 = 0. We don't really need that with
|
||||
|
|
@ -8469,7 +8469,7 @@ package body Exp_Ch4 is
|
|||
Binary_Op_Validity_Checks (N);
|
||||
|
||||
if Is_Integer_Type (Etype (N)) then
|
||||
Apply_Divide_Check (N);
|
||||
Apply_Divide_Checks (N);
|
||||
end if;
|
||||
|
||||
-- Apply optimization x rem 1 = 0. We don't really need that with gcc,
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- S p e c --
|
||||
-- --
|
||||
-- Copyright (C) 2001-2012, AdaCore --
|
||||
-- Copyright (C) 2001-2011, AdaCore --
|
||||
-- --
|
||||
-- GNAT is free software; you can redistribute it and/or modify it under --
|
||||
-- terms of the GNU General Public License as published by the Free Soft- --
|
||||
|
|
@ -1155,7 +1155,10 @@ private
|
|||
|
||||
type Fd_Set is
|
||||
new System.Storage_Elements.Storage_Array (1 .. SOSC.SIZEOF_fd_set);
|
||||
for Fd_Set'Alignment use SOSC.ALIGNOF_fd_set;
|
||||
for Fd_Set'Alignment use Interfaces.C.long'Alignment;
|
||||
-- Set conservative alignment so that our Fd_Sets are always adequately
|
||||
-- aligned for the underlying data type (which is implementation defined
|
||||
-- and may be an array of C long integers).
|
||||
|
||||
type Fd_Set_Access is access all Fd_Set;
|
||||
pragma Convention (C, Fd_Set_Access);
|
||||
|
|
|
|||
|
|
@ -1024,10 +1024,21 @@ package body System.Bignums is
|
|||
if X = 0 then
|
||||
R := Allocate_Bignum (0);
|
||||
|
||||
-- One word result
|
||||
|
||||
elsif X in -(2 ** 32 - 1) .. +(2 ** 32 - 1) then
|
||||
R := Allocate_Bignum (1);
|
||||
R.D (1) := SD (abs (X));
|
||||
|
||||
-- Largest negative number annoyance
|
||||
|
||||
elsif X = Long_Long_Integer'First then
|
||||
R := Allocate_Bignum (2);
|
||||
R.D (1) := 2 ** 31;
|
||||
R.D (2) := 0;
|
||||
|
||||
-- Normal two word case
|
||||
|
||||
else
|
||||
R := Allocate_Bignum (2);
|
||||
R.D (2) := SD (abs (X) mod Base);
|
||||
|
|
|
|||
|
|
@ -1292,7 +1292,7 @@ CNS(MAX_tv_sec, "")
|
|||
}
|
||||
/*
|
||||
|
||||
-- Sizes and alignments of various data types
|
||||
-- Sizes of various data types
|
||||
*/
|
||||
|
||||
#define SIZEOF_sockaddr_in (sizeof (struct sockaddr_in))
|
||||
|
|
@ -1306,9 +1306,6 @@ CND(SIZEOF_sockaddr_in6, "struct sockaddr_in6")
|
|||
|
||||
#define SIZEOF_fd_set (sizeof (fd_set))
|
||||
CND(SIZEOF_fd_set, "fd_set");
|
||||
#define ALIGNOF_fd_set (__alignof__ (fd_set))
|
||||
CND(ALIGNOF_fd_set, "");
|
||||
|
||||
CND(FD_SETSIZE, "Max fd value");
|
||||
|
||||
#define SIZEOF_struct_hostent (sizeof (struct hostent))
|
||||
|
|
|
|||
|
|
@ -730,6 +730,20 @@ package body Sem is
|
|||
Scope_Suppress := Svg;
|
||||
end;
|
||||
|
||||
elsif Suppress = Overflow_Check then
|
||||
declare
|
||||
Svg : constant Overflow_Check_Type :=
|
||||
Scope_Suppress.Overflow_Checks_General;
|
||||
Sva : constant Overflow_Check_Type :=
|
||||
Scope_Suppress.Overflow_Checks_Assertions;
|
||||
begin
|
||||
Scope_Suppress.Overflow_Checks_General := Suppressed;
|
||||
Scope_Suppress.Overflow_Checks_Assertions := Suppressed;
|
||||
Analyze (N);
|
||||
Scope_Suppress.Overflow_Checks_General := Svg;
|
||||
Scope_Suppress.Overflow_Checks_Assertions := Sva;
|
||||
end;
|
||||
|
||||
else
|
||||
declare
|
||||
Svg : constant Boolean := Scope_Suppress.Suppress (Suppress);
|
||||
|
|
@ -769,6 +783,20 @@ package body Sem is
|
|||
Scope_Suppress := Svg;
|
||||
end;
|
||||
|
||||
elsif Suppress = Overflow_Check then
|
||||
declare
|
||||
Svg : constant Overflow_Check_Type :=
|
||||
Scope_Suppress.Overflow_Checks_General;
|
||||
Sva : constant Overflow_Check_Type :=
|
||||
Scope_Suppress.Overflow_Checks_Assertions;
|
||||
begin
|
||||
Scope_Suppress.Overflow_Checks_General := Suppressed;
|
||||
Scope_Suppress.Overflow_Checks_Assertions := Suppressed;
|
||||
Analyze_List (L);
|
||||
Scope_Suppress.Overflow_Checks_General := Svg;
|
||||
Scope_Suppress.Overflow_Checks_Assertions := Sva;
|
||||
end;
|
||||
|
||||
else
|
||||
declare
|
||||
Svg : constant Boolean := Scope_Suppress.Suppress (Suppress);
|
||||
|
|
|
|||
|
|
@ -322,7 +322,7 @@ package body Sem_Res is
|
|||
Resolve (N, Typ);
|
||||
end Analyze_And_Resolve;
|
||||
|
||||
-- Version withs check(s) suppressed
|
||||
-- Versions with check(s) suppressed
|
||||
|
||||
procedure Analyze_And_Resolve
|
||||
(N : Node_Id;
|
||||
|
|
@ -341,6 +341,20 @@ package body Sem_Res is
|
|||
Scope_Suppress := Svg;
|
||||
end;
|
||||
|
||||
elsif Suppress = Overflow_Check then
|
||||
declare
|
||||
Svg : constant Overflow_Check_Type :=
|
||||
Scope_Suppress.Overflow_Checks_General;
|
||||
Sva : constant Overflow_Check_Type :=
|
||||
Scope_Suppress.Overflow_Checks_Assertions;
|
||||
begin
|
||||
Scope_Suppress.Overflow_Checks_General := Suppressed;
|
||||
Scope_Suppress.Overflow_Checks_Assertions := Suppressed;
|
||||
Analyze_And_Resolve (N, Typ);
|
||||
Scope_Suppress.Overflow_Checks_General := Svg;
|
||||
Scope_Suppress.Overflow_Checks_Assertions := Sva;
|
||||
end;
|
||||
|
||||
else
|
||||
declare
|
||||
Svg : constant Boolean := Scope_Suppress.Suppress (Suppress);
|
||||
|
|
@ -381,6 +395,20 @@ package body Sem_Res is
|
|||
Scope_Suppress := Svg;
|
||||
end;
|
||||
|
||||
elsif Suppress = Overflow_Check then
|
||||
declare
|
||||
Svg : constant Overflow_Check_Type :=
|
||||
Scope_Suppress.Overflow_Checks_General;
|
||||
Sva : constant Overflow_Check_Type :=
|
||||
Scope_Suppress.Overflow_Checks_Assertions;
|
||||
begin
|
||||
Scope_Suppress.Overflow_Checks_General := Suppressed;
|
||||
Scope_Suppress.Overflow_Checks_Assertions := Suppressed;
|
||||
Analyze_And_Resolve (N);
|
||||
Scope_Suppress.Overflow_Checks_General := Svg;
|
||||
Scope_Suppress.Overflow_Checks_Assertions := Sva;
|
||||
end;
|
||||
|
||||
else
|
||||
declare
|
||||
Svg : constant Boolean := Scope_Suppress.Suppress (Suppress);
|
||||
|
|
|
|||
Loading…
Reference in New Issue