Commit a91e9ac7 by Arnaud Charlet

[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
parent 6cb3037c
2012-10-01 Robert Dewar <dewar@adacore.com> 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 * checks.adb (Minimize_Eliminate_Overflow_Checks): Changes
for exponentiation. for exponentiation.
* exp_ch4.adb (Expand_N_Op_Expon): Changes for Minimize/Eliminate * exp_ch4.adb (Expand_N_Op_Expon): Changes for Minimize/Eliminate
......
...@@ -166,6 +166,13 @@ package Checks is ...@@ -166,6 +166,13 @@ package Checks is
-- formals, the check is performed only if the corresponding actual is -- formals, the check is performed only if the corresponding actual is
-- constrained, i.e., whether Lhs'Constrained is True. -- 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); procedure Apply_Parameter_Aliasing_And_Validity_Checks (Subp : Entity_Id);
-- Given a subprogram Subp, add both a pre and post condition pragmas that -- Given a subprogram Subp, add both a pre and post condition pragmas that
-- detect aliased objects and verify the proper initialization of scalars -- detect aliased objects and verify the proper initialization of scalars
...@@ -176,12 +183,6 @@ package Checks is ...@@ -176,12 +183,6 @@ package Checks is
-- for Typ, if Typ has a predicate function. The check is applied only -- for Typ, if Typ has a predicate function. The check is applied only
-- if the type of N does not match Typ. -- 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); procedure Apply_Type_Conversion_Checks (N : Node_Id);
-- N is an N_Type_Conversion node. A type conversion actually involves -- 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 -- two sorts of checks. The first check is the checks that ensures that
......
...@@ -6584,7 +6584,7 @@ package body Exp_Ch4 is ...@@ -6584,7 +6584,7 @@ package body Exp_Ch4 is
-- Non-fixed point cases, do integer zero divide and overflow checks -- Non-fixed point cases, do integer zero divide and overflow checks
elsif Is_Integer_Type (Typ) then elsif Is_Integer_Type (Typ) then
Apply_Divide_Check (N); Apply_Divide_Checks (N);
-- Deal with Vax_Float -- Deal with Vax_Float
...@@ -7836,7 +7836,7 @@ package body Exp_Ch4 is ...@@ -7836,7 +7836,7 @@ package body Exp_Ch4 is
else else
if Is_Integer_Type (Etype (N)) then if Is_Integer_Type (Etype (N)) then
Apply_Divide_Check (N); Apply_Divide_Checks (N);
end if; end if;
-- Apply optimization x mod 1 = 0. We don't really need that with -- Apply optimization x mod 1 = 0. We don't really need that with
...@@ -8469,7 +8469,7 @@ package body Exp_Ch4 is ...@@ -8469,7 +8469,7 @@ package body Exp_Ch4 is
Binary_Op_Validity_Checks (N); Binary_Op_Validity_Checks (N);
if Is_Integer_Type (Etype (N)) then if Is_Integer_Type (Etype (N)) then
Apply_Divide_Check (N); Apply_Divide_Checks (N);
end if; end if;
-- Apply optimization x rem 1 = 0. We don't really need that with gcc, -- Apply optimization x rem 1 = 0. We don't really need that with gcc,
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -1155,7 +1155,10 @@ private ...@@ -1155,7 +1155,10 @@ private
type Fd_Set is type Fd_Set is
new System.Storage_Elements.Storage_Array (1 .. SOSC.SIZEOF_fd_set); 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; type Fd_Set_Access is access all Fd_Set;
pragma Convention (C, Fd_Set_Access); pragma Convention (C, Fd_Set_Access);
......
...@@ -1024,10 +1024,21 @@ package body System.Bignums is ...@@ -1024,10 +1024,21 @@ package body System.Bignums is
if X = 0 then if X = 0 then
R := Allocate_Bignum (0); R := Allocate_Bignum (0);
-- One word result
elsif X in -(2 ** 32 - 1) .. +(2 ** 32 - 1) then elsif X in -(2 ** 32 - 1) .. +(2 ** 32 - 1) then
R := Allocate_Bignum (1); R := Allocate_Bignum (1);
R.D (1) := SD (abs (X)); 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 else
R := Allocate_Bignum (2); R := Allocate_Bignum (2);
R.D (2) := SD (abs (X) mod Base); R.D (2) := SD (abs (X) mod Base);
......
...@@ -1292,7 +1292,7 @@ CNS(MAX_tv_sec, "") ...@@ -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)) #define SIZEOF_sockaddr_in (sizeof (struct sockaddr_in))
...@@ -1306,9 +1306,6 @@ CND(SIZEOF_sockaddr_in6, "struct sockaddr_in6") ...@@ -1306,9 +1306,6 @@ CND(SIZEOF_sockaddr_in6, "struct sockaddr_in6")
#define SIZEOF_fd_set (sizeof (fd_set)) #define SIZEOF_fd_set (sizeof (fd_set))
CND(SIZEOF_fd_set, "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"); CND(FD_SETSIZE, "Max fd value");
#define SIZEOF_struct_hostent (sizeof (struct hostent)) #define SIZEOF_struct_hostent (sizeof (struct hostent))
......
...@@ -730,6 +730,20 @@ package body Sem is ...@@ -730,6 +730,20 @@ package body Sem is
Scope_Suppress := Svg; Scope_Suppress := Svg;
end; 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 else
declare declare
Svg : constant Boolean := Scope_Suppress.Suppress (Suppress); Svg : constant Boolean := Scope_Suppress.Suppress (Suppress);
...@@ -769,6 +783,20 @@ package body Sem is ...@@ -769,6 +783,20 @@ package body Sem is
Scope_Suppress := Svg; Scope_Suppress := Svg;
end; 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 else
declare declare
Svg : constant Boolean := Scope_Suppress.Suppress (Suppress); Svg : constant Boolean := Scope_Suppress.Suppress (Suppress);
......
...@@ -322,7 +322,7 @@ package body Sem_Res is ...@@ -322,7 +322,7 @@ package body Sem_Res is
Resolve (N, Typ); Resolve (N, Typ);
end Analyze_And_Resolve; end Analyze_And_Resolve;
-- Version withs check(s) suppressed -- Versions with check(s) suppressed
procedure Analyze_And_Resolve procedure Analyze_And_Resolve
(N : Node_Id; (N : Node_Id;
...@@ -341,6 +341,20 @@ package body Sem_Res is ...@@ -341,6 +341,20 @@ package body Sem_Res is
Scope_Suppress := Svg; Scope_Suppress := Svg;
end; 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 else
declare declare
Svg : constant Boolean := Scope_Suppress.Suppress (Suppress); Svg : constant Boolean := Scope_Suppress.Suppress (Suppress);
...@@ -381,6 +395,20 @@ package body Sem_Res is ...@@ -381,6 +395,20 @@ package body Sem_Res is
Scope_Suppress := Svg; Scope_Suppress := Svg;
end; 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 else
declare declare
Svg : constant Boolean := Scope_Suppress.Suppress (Suppress); Svg : constant Boolean := Scope_Suppress.Suppress (Suppress);
......
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