[multiple changes]
2015-01-07 Tristan Gingold <gingold@adacore.com> * i-cpoint.adb (Copy_Terminated_Array): Use Copy_Array to handle overlap. 2015-01-07 Eric Botcazou <ebotcazou@adacore.com> * sem_ch3.adb (Analyze_Full_Type_Declaration): Do not automatically set No_Strict_Aliasing on access types. * fe.h (No_Strict_Aliasing_CP): Declare. * gcc-interface/trans.c (gigi): Force flag_strict_aliasing to 0 if No_Strict_Aliasing_CP is set. 2015-01-07 Johannes Kanig <kanig@adacore.com> * sem_ch8.adb (Analyze_Subprogram_Renaming) do not build function wrapper in gnatprove mode when the package is externally axiomatized. 2015-01-07 Jose Ruiz <ruiz@adacore.com> * a-reatim.adb (Time_Of): Reduce the number of spurious overflows in intermediate computations when the parameters have different signs. 2015-01-07 Javier Miranda <miranda@adacore.com> * exp_ch3.adb (Build_Init_Procedure): For derived types, improve the code which takes care of identifying and moving to the beginning of the init-proc the call to the init-proc of the parent type. From-SVN: r219287
This commit is contained in:
Arnaud Charlet
parent
1a9ee22281
commit
c3831524bc
|
|
@ -1,3 +1,34 @@
|
|||
2015-01-07 Tristan Gingold <gingold@adacore.com>
|
||||
|
||||
* i-cpoint.adb (Copy_Terminated_Array): Use Copy_Array to
|
||||
handle overlap.
|
||||
|
||||
2015-01-07 Eric Botcazou <ebotcazou@adacore.com>
|
||||
|
||||
* sem_ch3.adb (Analyze_Full_Type_Declaration): Do not
|
||||
automatically set No_Strict_Aliasing on access types.
|
||||
* fe.h (No_Strict_Aliasing_CP): Declare.
|
||||
* gcc-interface/trans.c (gigi): Force flag_strict_aliasing to 0 if
|
||||
No_Strict_Aliasing_CP is set.
|
||||
|
||||
2015-01-07 Johannes Kanig <kanig@adacore.com>
|
||||
|
||||
* sem_ch8.adb (Analyze_Subprogram_Renaming) do
|
||||
not build function wrapper in gnatprove mode when the package
|
||||
is externally axiomatized.
|
||||
|
||||
2015-01-07 Jose Ruiz <ruiz@adacore.com>
|
||||
|
||||
* a-reatim.adb (Time_Of): Reduce the number of spurious overflows in
|
||||
intermediate computations when the parameters have different signs.
|
||||
|
||||
2015-01-07 Javier Miranda <miranda@adacore.com>
|
||||
|
||||
* exp_ch3.adb (Build_Init_Procedure): For derived types,
|
||||
improve the code which takes care of identifying and moving to
|
||||
the beginning of the init-proc the call to the init-proc of the
|
||||
parent type.
|
||||
|
||||
2015-01-07 Olivier Hainque <hainque@adacore.com>
|
||||
|
||||
* gcc-interface/trans.c (gnat_to_gnu, <N_Expression_With_Action>):
|
||||
|
|
|
|||
|
|
@ -218,7 +218,58 @@ package body Ada.Real_Time is
|
|||
|
||||
function Time_Of (SC : Seconds_Count; TS : Time_Span) return Time is
|
||||
begin
|
||||
return Time (SC) + TS;
|
||||
-- We want to return Time (SC) + TS. To avoid spurious overflows in
|
||||
-- the intermediate result Time (SC) we take advantage of the different
|
||||
-- signs in SC and TS (when that is the case).
|
||||
|
||||
-- If signs of SC and TS are different then we avoid converting SC to
|
||||
-- Time (as we do in the else part). The reason for that is that SC
|
||||
-- converted to Time may overflow the range of Time, while the addition
|
||||
-- of SC plus TS does not overflow (because of their different signs).
|
||||
-- The approach is to add and remove the greatest value of time
|
||||
-- (greatest absolute value) to both SC and TS. SC and TS have different
|
||||
-- signs, so we add the positive constant to the negative value, and the
|
||||
-- negative constant to the positive value, to prevent overflows.
|
||||
|
||||
if (SC > 0 and then TS < 0.0)
|
||||
or else (SC < 0 and then TS > 0.0)
|
||||
then
|
||||
declare
|
||||
Closest_Boundary : constant Seconds_Count :=
|
||||
(if TS >= 0.0 then
|
||||
Seconds_Count (Time_Span_Last - Time_Span (0.5))
|
||||
else
|
||||
Seconds_Count (Time_Span_First + Time_Span (0.5)));
|
||||
-- Value representing the integer part of the Time_Span boundary
|
||||
-- closest to TS (its number of seconds). Truncate towards zero
|
||||
-- to be sure that transforming this value back into Time cannot
|
||||
-- overflow (when SC is equal to 0). The sign of Closest_Boundary
|
||||
-- is always different from the sign of SC, hence avoiding
|
||||
-- overflow in the expression Time (SC + Closest_Boundary)
|
||||
-- which is part of the return statement.
|
||||
|
||||
Dist_To_Boundary : constant Time_Span :=
|
||||
TS - Time_Span (Closest_Boundary);
|
||||
-- Distance between TS and Closest_Boundary expressed in Time_Span
|
||||
-- Both operands in the substraction have the same sign, hence
|
||||
-- avoiding overflow.
|
||||
|
||||
begin
|
||||
-- Both operands in the inner addition have different signs,
|
||||
-- hence avoiding overflow. The Time () conversion and the outer
|
||||
-- addition can overflow only if SC + TC is not within Time'Range.
|
||||
|
||||
return Time (SC + Closest_Boundary) + Dist_To_Boundary;
|
||||
end;
|
||||
|
||||
-- Both operands have the same sign, so we can convert SC into Time
|
||||
-- right away; if this conversion overflows then the result of adding SC
|
||||
-- and TS would overflow anyway (so we would just be detecting the
|
||||
-- overflow a bit earlier).
|
||||
|
||||
else
|
||||
return Time (SC) + TS;
|
||||
end if;
|
||||
end Time_Of;
|
||||
|
||||
-----------------
|
||||
|
|
|
|||
|
|
@ -2391,11 +2391,43 @@ package body Exp_Ch3 is
|
|||
-- such case the initialization of the _parent field was not
|
||||
-- generated.
|
||||
|
||||
if not Is_Interface (Etype (Rec_Ent))
|
||||
and then Nkind (First (Stmts)) = N_Procedure_Call_Statement
|
||||
and then Is_Init_Proc (Name (First (Stmts)))
|
||||
then
|
||||
Prepend_To (Body_Stmts, Remove_Head (Stmts));
|
||||
if not Is_Interface (Etype (Rec_Ent)) then
|
||||
declare
|
||||
Parent_IP : constant Name_Id :=
|
||||
Make_Init_Proc_Name (Etype (Rec_Ent));
|
||||
Stmt : Node_Id := First (Stmts);
|
||||
IP_Call : Node_Id := Empty;
|
||||
IP_Stmts : List_Id;
|
||||
|
||||
begin
|
||||
-- Look for a call to the parent IP at the beginning
|
||||
-- of Stmts associated with the record extension
|
||||
|
||||
while Present (Stmt) loop
|
||||
if Nkind (Stmt) = N_Procedure_Call_Statement
|
||||
and then Chars (Name (Stmt)) = Parent_IP
|
||||
then
|
||||
IP_Call := Stmt;
|
||||
exit;
|
||||
end if;
|
||||
|
||||
Next (Stmt);
|
||||
end loop;
|
||||
|
||||
-- If found then move it to the beginning of the
|
||||
-- statements of this IP routine
|
||||
|
||||
if Present (IP_Call) then
|
||||
IP_Stmts := New_List;
|
||||
loop
|
||||
Stmt := Remove_Head (Stmts);
|
||||
Append_To (IP_Stmts, Stmt);
|
||||
exit when Stmt = IP_Call;
|
||||
end loop;
|
||||
|
||||
Prepend_List_To (Body_Stmts, IP_Stmts);
|
||||
end if;
|
||||
end;
|
||||
end if;
|
||||
|
||||
Append_List_To (Body_Stmts, Stmts);
|
||||
|
|
|
|||
|
|
@ -176,6 +176,7 @@ extern Boolean In_Same_Source_Unit (Node_Id, Node_Id);
|
|||
#define Generate_SCO_Instance_Table opt__generate_sco_instance_table
|
||||
#define GNAT_Mode opt__gnat_mode
|
||||
#define List_Representation_Info opt__list_representation_info
|
||||
#define No_Strict_Aliasing_CP opt__no_strict_aliasing
|
||||
|
||||
typedef enum {Setjmp_Longjmp, Back_End_Exceptions} Exception_Mechanism_Type;
|
||||
|
||||
|
|
@ -187,6 +188,7 @@ extern Char Float_Format;
|
|||
extern Boolean Generate_SCO_Instance_Table;
|
||||
extern Boolean GNAT_Mode;
|
||||
extern Int List_Representation_Info;
|
||||
extern Boolean No_Strict_Aliasing_CP;
|
||||
|
||||
/* restrict: */
|
||||
|
||||
|
|
|
|||
|
|
@ -667,6 +667,10 @@ gigi (Node_Id gnat_root,
|
|||
/* Initialize the GCC support for FP operations. */
|
||||
gnat_init_gcc_fp ();
|
||||
|
||||
/* Force -fno-strict-aliasing if the configuration pragma was seen. */
|
||||
if (No_Strict_Aliasing_CP)
|
||||
flag_strict_aliasing = 0;
|
||||
|
||||
/* Now translate the compilation unit proper. */
|
||||
Compilation_Unit_to_gnu (gnat_root);
|
||||
|
||||
|
|
|
|||
|
|
@ -143,23 +143,21 @@ package body Interfaces.C.Pointers is
|
|||
Limit : ptrdiff_t := ptrdiff_t'Last;
|
||||
Terminator : Element := Default_Terminator)
|
||||
is
|
||||
S : Pointer := Source;
|
||||
T : Pointer := Target;
|
||||
L : ptrdiff_t := Limit;
|
||||
|
||||
L : ptrdiff_t;
|
||||
S : Pointer := Source;
|
||||
begin
|
||||
if S = null or else T = null then
|
||||
if Source = null then
|
||||
raise Dereference_Error;
|
||||
|
||||
else
|
||||
while L > 0 loop
|
||||
T.all := S.all;
|
||||
exit when T.all = Terminator;
|
||||
Increment (T);
|
||||
Increment (S);
|
||||
L := L - 1;
|
||||
end loop;
|
||||
end if;
|
||||
|
||||
-- Compute array length (including the terminator)
|
||||
L := 1;
|
||||
while S.all /= Terminator and then L < Limit loop
|
||||
L := L + 1;
|
||||
Increment (S);
|
||||
end loop;
|
||||
|
||||
Copy_Array (Source, Target, L);
|
||||
end Copy_Terminated_Array;
|
||||
|
||||
---------------
|
||||
|
|
|
|||
|
|
@ -2657,12 +2657,6 @@ package body Sem_Ch3 is
|
|||
Add_RACW_Features (Def_Id);
|
||||
end if;
|
||||
|
||||
-- Set no strict aliasing flag if config pragma seen
|
||||
|
||||
if Opt.No_Strict_Aliasing then
|
||||
Set_No_Strict_Aliasing (Base_Type (Def_Id));
|
||||
end if;
|
||||
|
||||
when N_Array_Type_Definition =>
|
||||
Array_Type_Declaration (T, Def);
|
||||
|
||||
|
|
|
|||
|
|
@ -2710,7 +2710,17 @@ package body Sem_Ch8 is
|
|||
-- Check whether the renaming is for a defaulted actual subprogram
|
||||
-- with a class-wide actual.
|
||||
|
||||
if CW_Actual and then Box_Present (Inst_Node) then
|
||||
-- The class-wide wrapper is not needed when we are in
|
||||
-- GNATprove_Mode and there is an external axiomatization on the
|
||||
-- package.
|
||||
|
||||
if CW_Actual
|
||||
and then Box_Present (Inst_Node)
|
||||
and then not (GNATprove_Mode
|
||||
and then
|
||||
Present (Containing_Package_With_Ext_Axioms
|
||||
(Formal_Spec)))
|
||||
then
|
||||
Build_Class_Wide_Wrapper (New_S, Old_S);
|
||||
|
||||
elsif Is_Entity_Name (Nam)
|
||||
|
|
|
|||
Loading…
Reference in New Issue