diff options
| -rw-r--r-- | gcc/ada/ChangeLog | 20 | ||||
| -rw-r--r-- | gcc/ada/exp_ch4.adb | 40 | ||||
| -rw-r--r-- | gcc/ada/exp_util.adb | 44 | ||||
| -rw-r--r-- | gcc/ada/init.c | 4 | ||||
| -rw-r--r-- | gcc/ada/sem_attr.adb | 43 |
5 files changed, 143 insertions, 8 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 8ce008e..0b5f0c2 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,5 +1,25 @@ 2014-07-29 Doug Rupp <rupp@adacore.com> + * init.c: Complete previous change. + +2014-07-29 Robert Dewar <dewar@adacore.com> + + * exp_ch4.adb (Expand_N_If_Expression): Deal with unconstrained + array case. + +2014-07-29 Ed Schonberg <schonberg@adacore.com> + + * 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 <rupp@adacore.com> + * sigtramp-armvxw.c: Enhance to handle RTP trampolining. * init.c: Remove guard on sigtramp for ARM VxWorks RTP. diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index d8ce961..1712a7d 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 6f8ad43..4a68d1d 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 41156ce..5f764f6 100644 --- a/gcc/ada/init.c +++ b/gcc/ada/init.c @@ -1703,9 +1703,7 @@ __gnat_install_handler () #include <signal.h> #include <taskLib.h> -#ifdef __RTP__ -#include <base/b_ucontext_t.h> -#else +#ifndef __RTP__ #include <intLib.h> #include <iv.h> #endif diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index 6c3b72d..67955e9 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; ------------- |