OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

[multiple changes] 

2013-10-14  Robert Dewar  <dewar@adacore.com>

	* exp_prag.adb: Minor reformatting.

2013-10-14  Ed Schonberg  <schonberg@adacore.com>

	* sem_case.adb (Check_Against_Predicate): Handle properly an
	others clause in various cases.

2013-10-14  Hristian Kirtchev  <kirtchev@adacore.com>

	* 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  <rupp@adacore.com>

	* 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  <charlet@adacore.com>

	* gnat_rm.texi, adaint.c: Fix typo.

2013-10-14  Ed Schonberg  <schonberg@adacore.com>

	* 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
This commit is contained in:
Arnaud Charlet 2013-10-14 15:31:52 +02:00
parent 5644b7e8e7
commit 1e7bc06555
8 changed files with 125 additions and 47 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

31
gcc/ada/ChangeLog
View File

@ -1,3 +1,34 @@
2013-10-14 Robert Dewar <dewar@adacore.com>
* exp_prag.adb: Minor reformatting.
2013-10-14 Ed Schonberg <schonberg@adacore.com>
* sem_case.adb (Check_Against_Predicate): Handle properly an
others clause in various cases.
2013-10-14 Hristian Kirtchev <kirtchev@adacore.com>
* 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 <rupp@adacore.com>
* 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 <charlet@adacore.com>
* gnat_rm.texi, adaint.c: Fix typo.
2013-10-14 Ed Schonberg <schonberg@adacore.com>
* 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 <celier@adacore.com>
* snames.ads-tmpl: Add new standard name Library_Rpath_Options.

2
gcc/ada/adaint.c
View File

@ -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;

45
gcc/ada/exp_prag.adb
View File

@ -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);
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;
Rtti_Name : constant Node_Id := Arg3 (N);
Dum : constant Entity_Id := Make_Temporary (Loc, 'D');
begin
Exdata := Component_Associations (Expression (Parent (Def_Id)));
@ -599,8 +605,7 @@ 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'))));
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;

2
gcc/ada/gnat_rm.texi
View File

@ -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.

29
gcc/ada/init.c
View File

@ -1663,6 +1663,10 @@ __gnat_install_handler ()
#include <iv.h>
#endif
#if defined (ARMEL) && (_WRS_VXWORKS_MAJOR == 6)
#include <vmLib.h>
#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)

13
gcc/ada/sem_case.adb
View File

@ -319,8 +319,16 @@ package body Sem_Case is
-- ^ illegal ^
elsif Pred_Lo < Choice_Lo and then Pred_Hi < Choice_Lo then
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;
-- 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
-- +===========+===========+

8
gcc/ada/sem_prag.adb
View File

@ -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.

26
gcc/ada/sem_util.adb
View File

@ -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;