From: Arnaud Charlet Date: Tue, 29 Jul 2014 13:51:03 +0000 (+0200) Subject: [multiple changes] X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=113a9fb6c6c0b2ce325440352bc3b9039e6e07ed;p=gcc.git [multiple changes] 2014-07-29 Doug Rupp * init.c: Complete previous change. 2014-07-29 Robert Dewar * exp_ch4.adb (Expand_N_If_Expression): Deal with unconstrained array case. 2014-07-29 Ed Schonberg * sem_attr.adb (Access_Attribute): If the prefix is a subprogram and the completion will appear in the same declarative part, create elaboration flag. * exp_util.adb (Set_Elaboration_Flag): If the subprogram body is a completion of a declaration in the same declarative part, and the subprogram has had its address taken, add elaboration check inside the subprogram body, to detect elaboration errors that may occur through indirect calls. From-SVN: r213189 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 8ce008efa95..0b5f0c249b9 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,23 @@ +2014-07-29 Doug Rupp + + * init.c: Complete previous change. + +2014-07-29 Robert Dewar + + * exp_ch4.adb (Expand_N_If_Expression): Deal with unconstrained + array case. + +2014-07-29 Ed Schonberg + + * sem_attr.adb (Access_Attribute): If the prefix is a subprogram + and the completion will appear in the same declarative part, + create elaboration flag. + * exp_util.adb (Set_Elaboration_Flag): If the subprogram body + is a completion of a declaration in the same declarative part, + and the subprogram has had its address taken, add elaboration + check inside the subprogram body, to detect elaboration errors + that may occur through indirect calls. + 2014-07-29 Doug Rupp * sigtramp-armvxw.c: Enhance to handle RTP trampolining. diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index d8ce9611c42..1712a7d9755 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -5278,11 +5278,9 @@ package body Exp_Ch4 is return; end if; - -- If the type is limited or unconstrained, we expand as follows to - -- avoid any possibility of improper copies. - - -- Note: it may be possible to avoid this special processing if the - -- back end uses its own mechanisms for handling by-reference types ??? + -- If the type is limited, and the back end does not handle limited + -- types, then we expand as follows to avoid the possibility of + -- improper copying. -- type Ptr is access all Typ; -- Cnn : Ptr; @@ -5370,6 +5368,38 @@ package body Exp_Ch4 is Make_Explicit_Dereference (Loc, Prefix => New_Occurrence_Of (Cnn, Loc)); + -- If the result is an unconstrained array and the if expression is in a + -- context other than the initializing expression of the declaration of + -- an object, then we pull out the if expression as follows: + + -- Cnn : constant typ := if-expression + + -- and then replace the if expression with an occurrence of Cnn. This + -- avoids the need in the back end to create on-the-fly variable length + -- temporaries (which it cannot do!) + + -- Note that the test for being in an object declaration avoids doing an + -- unnecessary expansion, and also avoids infinite recursion. + + elsif Is_Array_Type (Typ) and then not Is_Constrained (Typ) + and then (Nkind (Parent (N)) /= N_Object_Declaration + or else Expression (Parent (N)) /= N) + then + declare + Cnn : constant Node_Id := Make_Temporary (Loc, 'C', N); + begin + Insert_Action (N, + Make_Object_Declaration (Loc, + Defining_Identifier => Cnn, + Constant_Present => True, + Object_Definition => New_Occurrence_Of (Typ, Loc), + Expression => Relocate_Node (N), + Has_Init_Expression => True)); + + Rewrite (N, New_Occurrence_Of (Cnn, Loc)); + return; + end; + -- For other types, we only need to expand if there are other actions -- associated with either branch. diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb index 6f8ad43843f..4a68d1d226f 100644 --- a/gcc/ada/exp_util.adb +++ b/gcc/ada/exp_util.adb @@ -7920,6 +7920,50 @@ package body Exp_Util is -- pick up bogus indications of the wrong constant value. Set_Current_Value (Ent, Empty); + + -- If the subprogram is in the current declarative part and + -- 'access has been applied to it, generate an elaboration + -- check at the beginning of the declarations of the body. + + if Nkind (N) = N_Subprogram_Body + and then Address_Taken (Spec_Id) + and then + Ekind_In (Scope (Spec_Id), E_Block, E_Procedure, E_Function) + then + declare + Loc : constant Source_Ptr := Sloc (N); + Decls : constant List_Id := Declarations (N); + Chk : Node_Id; + + begin + -- No need to generate this check if first entry in the + -- declaration list is a raise of Program_Error now. + + if Present (Decls) + and then Nkind (First (Decls)) = N_Raise_Program_Error + then + return; + end if; + + -- Otherwise generate the check + + Chk := + Make_Raise_Program_Error (Loc, + Condition => + Make_Op_Eq (Loc, + Left_Opnd => New_Occurrence_Of (Ent, Loc), + Right_Opnd => Make_Integer_Literal (Loc, Uint_0)), + Reason => PE_Access_Before_Elaboration); + + if No (Decls) then + Set_Declarations (N, New_List (Chk)); + else + Prepend (Chk, Decls); + end if; + + Analyze (Chk); + end; + end if; end if; end if; end Set_Elaboration_Flag; diff --git a/gcc/ada/init.c b/gcc/ada/init.c index 41156cecd1e..5f764f6937d 100644 --- a/gcc/ada/init.c +++ b/gcc/ada/init.c @@ -1703,9 +1703,7 @@ __gnat_install_handler () #include #include -#ifdef __RTP__ -#include -#else +#ifndef __RTP__ #include #include #endif diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index 6c3b72df87e..67955e9903b 100644 --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -10568,6 +10568,49 @@ package body Sem_Attr is if Is_Entity_Name (P) then Set_Address_Taken (Entity (P)); end if; + + if Is_Entity_Name (P) then + declare + E : constant Entity_Id := Entity (P); + Flag : Entity_Id; + + -- If the access has been taken and the body of the subprogram + -- has not been see yet, indirect calls must be protected with + -- elaboration checks. We have the proper elaboration machinery + -- for subprograms declared in packages, but within a block or + -- a subprogram the body will appear in the same declarative + -- part, and we must insert a check in the eventual body itself + -- using the elaboration flag that we generate now. The check + -- is then inserted when the body is expanded. + + begin + if Is_Subprogram (E) + and then Comes_From_Source (E) + and then Comes_From_Source (N) + and then In_Open_Scopes (Scope (E)) + and then + Ekind_In (Scope (E), E_Block, E_Procedure, E_Function) + and then not Has_Completion (E) + and then No (Elaboration_Entity (E)) + and then Expander_Active + then + -- Create elaboration variable for it + + Flag := Make_Temporary (Loc, 'E'); + + Set_Elaboration_Entity (E, Flag); + + Insert_Action (N, + Make_Object_Declaration (Loc, + Defining_Identifier => Flag, + Object_Definition => + New_Occurrence_Of (Standard_Short_Integer, Loc), + Expression => + Make_Integer_Literal (Loc, Uint_0))); + Set_Is_Frozen (Flag); + end if; + end; + end if; end Access_Attribute; -------------