From 1e7bc06555257c73282c7ca1678a74d2cc6c7e6c Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Mon, 14 Oct 2013 15:31:52 +0200 Subject: [PATCH] [multiple changes] 2013-10-14 Robert Dewar * exp_prag.adb: Minor reformatting. 2013-10-14 Ed Schonberg * sem_case.adb (Check_Against_Predicate): Handle properly an others clause in various cases. 2013-10-14 Hristian Kirtchev * sem_prag.adb (Check_Matching_Constituent): Do not inspect the hidden states if there are no hidden states. This case arises when the constituents are states coming from a private child. 2013-10-14 Doug Rupp * init.c [ARMEL and VxWorks] (__gnat_map_signal): Re-arm guard page by clearing VALID bit vice setting page protection. 2013-10-14 Arnaud Charlet * gnat_rm.texi, adaint.c: Fix typo. 2013-10-14 Ed Schonberg * sem_util.adb (Is_Variable, In_Protected_Function): In the body of a protected function, the protected object itself is a constant (not just its components). From-SVN: r203550 --- gcc/ada/ChangeLog | 31 +++++++++++++++++++++++++++++ gcc/ada/adaint.c | 2 +- gcc/ada/exp_prag.adb | 55 +++++++++++++++++++++++++++++++--------------------- gcc/ada/gnat_rm.texi | 2 +- gcc/ada/init.c | 29 +++++++++++++-------------- gcc/ada/sem_case.adb | 19 +++++++++++++++--- gcc/ada/sem_prag.adb | 8 ++++++++ gcc/ada/sem_util.adb | 26 +++++++++++++++++++++---- 8 files changed, 125 insertions(+), 47 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 261885c..adb5e6d 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,34 @@ +2013-10-14 Robert Dewar + + * exp_prag.adb: Minor reformatting. + +2013-10-14 Ed Schonberg + + * sem_case.adb (Check_Against_Predicate): Handle properly an + others clause in various cases. + +2013-10-14 Hristian Kirtchev + + * sem_prag.adb (Check_Matching_Constituent): Do + not inspect the hidden states if there are no hidden states. This + case arises when the constituents are states coming from a + private child. + +2013-10-14 Doug Rupp + + * init.c [ARMEL and VxWorks] (__gnat_map_signal): Re-arm guard + page by clearing VALID bit vice setting page protection. + +2013-10-14 Arnaud Charlet + + * gnat_rm.texi, adaint.c: Fix typo. + +2013-10-14 Ed Schonberg + + * sem_util.adb (Is_Variable, In_Protected_Function): In the + body of a protected function, the protected object itself is a + constant (not just its components). + 2013-10-14 Vincent Celier * snames.ads-tmpl: Add new standard name Library_Rpath_Options. diff --git a/gcc/ada/adaint.c b/gcc/ada/adaint.c index e5a50a8..e447907 100644 --- a/gcc/ada/adaint.c +++ b/gcc/ada/adaint.c @@ -3982,7 +3982,7 @@ __gnat_get_executable_load_address (void) status = loadquery (L_GETINFO, buf, blen); if (status == 0) { - struct ldinfo *info = (struct ld_info *)buf; + struct ld_info *info = (struct ld_info *)buf; return info->ldinfo_textorg; } blen = blen * 2; diff --git a/gcc/ada/exp_prag.adb b/gcc/ada/exp_prag.adb index f47ed1a..f431478 100644 --- a/gcc/ada/exp_prag.adb +++ b/gcc/ada/exp_prag.adb @@ -543,30 +543,34 @@ package body Exp_Prag is -- Expand_Pragma_Import_Or_Interface -- --------------------------------------- - -- When applied to a variable, the default initialization must not be done. - -- As it is already done when the pragma is found, we just get rid of the - -- call the initialization procedure which followed the object declaration. - -- The call is inserted after the declaration, but validity checks may - -- also have been inserted and the initialization call does not necessarily - -- appear immediately after the object declaration. - - -- We can't use the freezing mechanism for this purpose, since we have to - -- elaborate the initialization expression when it is first seen (i.e. this - -- elaboration cannot be deferred to the freeze point). - procedure Expand_Pragma_Import_Or_Interface (N : Node_Id) is Def_Id : Entity_Id; Init_Call : Node_Id; begin Def_Id := Entity (Arg2 (N)); + + -- Variable case + if Ekind (Def_Id) = E_Variable then + -- When applied to a variable, the default initialization must not be + -- done. As it is already done when the pragma is found, we just get + -- rid of the call the initialization procedure which followed the + -- object declaration. The call is inserted after the declaration, + -- but validity checks may also have been inserted and thus the + -- initialization call does not necessarily appear immediately + -- after the object declaration. + + -- We can't use the freezing mechanism for this purpose, since we + -- have to elaborate the initialization expression when it is first + -- seen (so this elaboration cannot be deferred to the freeze point). + -- Find and remove generated initialization call for object, if any Init_Call := Remove_Init_Call (Def_Id, Rep_Clause => N); - -- Any default initialization expression should be removed (e.g., + -- Any default initialization expression should be removed (e.g. -- null defaults for access objects, zero initialization of packed -- bit arrays). Imported objects aren't allowed to have explicit -- initialization, so the expression must have been generated by @@ -575,19 +579,21 @@ package body Exp_Prag is if No (Init_Call) and then Present (Expression (Parent (Def_Id))) then Set_Expression (Parent (Def_Id), Empty); end if; + + -- Case of exception with convention C++ + elsif Ekind (Def_Id) = E_Exception and then Convention (Def_Id) = Convention_CPP then - -- Import a C++ convention declare - Loc : constant Source_Ptr := Sloc (N); - Exdata : List_Id; - Lang_Char : Node_Id; - Foreign_Data : Node_Id; - Rtti_Name : constant Node_Id := Arg3 (N); - Dum : constant Entity_Id := Make_Temporary (Loc, 'D'); + Loc : constant Source_Ptr := Sloc (N); + Rtti_Name : constant Node_Id := Arg3 (N); + Dum : constant Entity_Id := Make_Temporary (Loc, 'D'); + Exdata : List_Id; + Lang_Char : Node_Id; + Foreign_Data : Node_Id; begin Exdata := Component_Associations (Expression (Parent (Def_Id))); @@ -598,9 +604,8 @@ package body Exp_Prag is Rewrite (Expression (Lang_Char), Make_Character_Literal (Loc, - Chars => Name_uC, - Char_Literal_Value => - UI_From_Int (Character'Pos ('C')))); + Chars => Name_uC, + Char_Literal_Value => UI_From_Int (Character'Pos ('C')))); Analyze (Expression (Lang_Char)); -- Change the value of Foreign_Data @@ -633,6 +638,12 @@ package body Exp_Prag is Attribute_Name => Name_Address))); Analyze (Expression (Foreign_Data)); end; + + -- No special expansion required for any other case + + else + null; + end if; end Expand_Pragma_Import_Or_Interface; diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi index 68a2969..ff8013b 100644 --- a/gcc/ada/gnat_rm.texi +++ b/gcc/ada/gnat_rm.texi @@ -18886,7 +18886,7 @@ pragma Import (Cpp, [External_Name =>] static_string_EXPRESSION); @end smallexample -@noident +@noindent The @code{External_Name} is the name of the C++ RTTI symbol. You can then cover a specific C++ exception in an exception handler. diff --git a/gcc/ada/init.c b/gcc/ada/init.c index 8b00dbe..7f8b3a3 100644 --- a/gcc/ada/init.c +++ b/gcc/ada/init.c @@ -1663,6 +1663,10 @@ __gnat_install_handler () #include #endif +#if defined (ARMEL) && (_WRS_VXWORKS_MAJOR == 6) +#include +#endif + #ifdef VTHREADS #include "private/vThreadsP.h" #endif @@ -1799,9 +1803,8 @@ __gnat_map_signal (int sig, siginfo_t *si ATTRIBUTE_UNUSED, msg = "unhandled signal"; } - /* On ARM VxWorks 6.x, the guard page is left in a RWX state by the kernel - after being violated, so subsequent violations aren't detected. Even if - this defect is fixed, it seems dubious to rely on the signal value alone, + /* On ARM VxWorks 6.x, the guard page is left un-armed by the kernel + after being violated, so subsequent violations aren't detected. so we retrieve the address of the guard page from the TCB and compare it with the page that is violated (pREG 12 in the context) and re-arm that page if there's a match. Additionally we're are assured this is a @@ -1809,28 +1812,22 @@ __gnat_map_signal (int sig, siginfo_t *si ATTRIBUTE_UNUSED, to that effect. */ #if defined (ARMEL) && (_WRS_VXWORKS_MAJOR == 6) - /* We re-arm the guard page by re-setting it's attributes, however the - protection bits are just the low order seven (0x3f). - 0x00040 is the Valid Mask - 0x00f00 are Cache attributes - 0xff000 are Special attributes - We don't meddle with the 0xfff40 attributes. */ + /* We re-arm the guard page by marking it invalid */ #define PAGE_SIZE 4096 -#define MMU_ATTR_PROT_MSK 0x0000003f /* Protection Mask. */ -#define GUARD_PAGE_PROT 0x8101 /* Found by experiment. */ +#define REG_IP 12 if (sig == SIGSEGV || sig == SIGBUS || sig == SIGILL) { TASK_ID tid = taskIdSelf (); WIND_TCB *pTcb = taskTcb (tid); - unsigned long Violated_Page - = ((struct sigcontext *) sc)->sc_pregs->r[12] & ~(PAGE_SIZE - 1); + unsigned long violated_page + = ((struct sigcontext *) sc)->sc_pregs->r[REG_IP] & ~(PAGE_SIZE - 1); - if ((unsigned long) (pTcb->pStackEnd - PAGE_SIZE) == Violated_Page) + if ((unsigned long) (pTcb->pStackEnd - PAGE_SIZE) == violated_page) { - vmStateSet (NULL, Violated_Page, - PAGE_SIZE, MMU_ATTR_PROT_MSK, GUARD_PAGE_PROT); + vmStateSet (NULL, violated_page, + PAGE_SIZE, VM_STATE_MASK_VALID, VM_STATE_VALID_NOT); exception = &storage_error; switch (sig) diff --git a/gcc/ada/sem_case.adb b/gcc/ada/sem_case.adb index 68ac66a..33f2977 100644 --- a/gcc/ada/sem_case.adb +++ b/gcc/ada/sem_case.adb @@ -319,8 +319,16 @@ package body Sem_Case is -- ^ illegal ^ elsif Pred_Lo < Choice_Lo and then Pred_Hi < Choice_Lo then - Missing_Choice (Pred_Lo, Pred_Hi); - Error := True; + if Others_Present then + + -- Current predicate set is covered by others clause. + + null; + + else + Missing_Choice (Pred_Lo, Pred_Hi); + Error := True; + end if; -- There may be several static predicate sets between the current -- one and the choice. Inspect the next static predicate set. @@ -384,7 +392,12 @@ package body Sem_Case is if Others_Present then Prev_Lo := Choice_Lo; Prev_Hi := Choice_Hi; - Next (Pred); + + -- Check whether predicate set is fully covered by choice + + if Pred_Hi = Choice_Hi then + Next (Pred); + end if; -- Choice_Lo Choice_Hi Pred_Hi -- +===========+===========+ diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 133ee6a..95ac600 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -21118,6 +21118,14 @@ package body Sem_Prag is return; end if; + -- The related package has no hidden states, nothing to match. + -- This case arises when the constituents are states coming + -- from a private child. + + if No (Hidden_States) then + return; + end if; + -- Inspect the hidden states of the related package looking for -- a match. diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index df7e953..83decce 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -10198,7 +10198,8 @@ package body Sem_Util is function In_Protected_Function (E : Entity_Id) return Boolean; -- Within a protected function, the private components of the enclosing -- protected type are constants. A function nested within a (protected) - -- procedure is not itself protected. + -- procedure is not itself protected. Within the body of a protected + -- function the current instance of the protected type is a constant. function Is_Variable_Prefix (P : Node_Id) return Boolean; -- Prefixes can involve implicit dereferences, in which case we must @@ -10210,12 +10211,24 @@ package body Sem_Util is --------------------------- function In_Protected_Function (E : Entity_Id) return Boolean is - Prot : constant Entity_Id := Scope (E); + Prot : Entity_Id; S : Entity_Id; begin + if Is_Type (E) then + -- E is the current instance of a type. + + Prot := E; + + else + -- E is an object. + + Prot := Scope (E); + end if; + if not Is_Protected_Type (Prot) then return False; + else S := Current_Scope; while Present (S) and then S /= Prot loop @@ -10336,9 +10349,14 @@ package body Sem_Util is or else K = E_In_Out_Parameter or else K = E_Generic_In_Out_Parameter - -- Current instance of type + -- Current instance of type. If this is a protected type, check + -- that we are not within the body of one of its protected + -- functions. + + or else (Is_Type (E) + and then In_Open_Scopes (E) + and then not In_Protected_Function (E)) - or else (Is_Type (E) and then In_Open_Scopes (E)) or else (Is_Incomplete_Or_Private_Type (E) and then In_Open_Scopes (Full_View (E))); end; -- 2.7.4