From c3831524bc0bf8d15bc95e26832a2a5e0752f9cc Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Wed, 7 Jan 2015 10:52:50 +0100 Subject: [PATCH] [multiple changes] 2015-01-07 Tristan Gingold * i-cpoint.adb (Copy_Terminated_Array): Use Copy_Array to handle overlap. 2015-01-07 Eric Botcazou * 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 * 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 * 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 * 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 --- gcc/ada/ChangeLog | 31 ++++++++++++++++++++ gcc/ada/a-reatim.adb | 53 ++++++++++++++++++++++++++++++++++- gcc/ada/exp_ch3.adb | 42 +++++++++++++++++++++++---- gcc/ada/fe.h | 2 ++ gcc/ada/gcc-interface/trans.c | 4 +++ gcc/ada/i-cpoint.adb | 26 ++++++++--------- gcc/ada/sem_ch3.adb | 6 ---- gcc/ada/sem_ch8.adb | 12 +++++++- 8 files changed, 149 insertions(+), 27 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 0965f21f088..3fb4b233c8c 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,34 @@ +2015-01-07 Tristan Gingold + + * i-cpoint.adb (Copy_Terminated_Array): Use Copy_Array to + handle overlap. + +2015-01-07 Eric Botcazou + + * 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 + + * 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 + + * 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 + + * 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 * gcc-interface/trans.c (gnat_to_gnu, ): diff --git a/gcc/ada/a-reatim.adb b/gcc/ada/a-reatim.adb index f59d083b03c..1a233c49481 100644 --- a/gcc/ada/a-reatim.adb +++ b/gcc/ada/a-reatim.adb @@ -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; ----------------- diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb index d45dbddc41b..74afb6034c6 100644 --- a/gcc/ada/exp_ch3.adb +++ b/gcc/ada/exp_ch3.adb @@ -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); diff --git a/gcc/ada/fe.h b/gcc/ada/fe.h index fcd2f153324..88686e8c449 100644 --- a/gcc/ada/fe.h +++ b/gcc/ada/fe.h @@ -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: */ diff --git a/gcc/ada/gcc-interface/trans.c b/gcc/ada/gcc-interface/trans.c index e77aee0ae7d..a81467067b1 100644 --- a/gcc/ada/gcc-interface/trans.c +++ b/gcc/ada/gcc-interface/trans.c @@ -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); diff --git a/gcc/ada/i-cpoint.adb b/gcc/ada/i-cpoint.adb index afcb96b9d4c..6b3c84d2293 100644 --- a/gcc/ada/i-cpoint.adb +++ b/gcc/ada/i-cpoint.adb @@ -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; --------------- diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index ac52f08aeb9..2850afcdd2b 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -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); diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb index 26b697f3c3a..2b4f52830e1 100644 --- a/gcc/ada/sem_ch8.adb +++ b/gcc/ada/sem_ch8.adb @@ -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) -- 2.30.2