[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:
parent
5644b7e8e7
commit
1e7bc06555
|
@ -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.
|
||||
|
|
|
@ -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;
|
||||
|
|
|
@ -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;
|
||||
|
||||
|
|
|
@ -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.
|
||||
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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
|
||||
-- +===========+===========+
|
||||
|
|
|
@ -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.
|
||||
|
||||
|
|
|
@ -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;
|
||||
|
|
Loading…
Reference in New Issue