Skip to content

R
riscv-gcc-1
Commit 799d0e05 by Arnaud Charlet
Options

[multiple changes] 

2012-05-15  Robert Dewar  <dewar@adacore.com>

	* exp_ch7.adb, exp_ch11.adb, exp_ch11.ads: Minor reformatting.

2012-05-15  Thomas Quinot  <quinot@adacore.com>

	* sem_res.adb (Resolve): Enforce E.2.2(11/2) and E.2.2(12) for
	'Unrestricted_Access and 'Unchecked_Access (not just 'Access):
	even in those cases, a remote access type may only designate a
	remote subprogram.

2012-05-15  Thomas Quinot  <quinot@adacore.com>

	* sem_util.adb, sem_util.ads, sem_cat.adb: Minor refactoring.
	(Enclosing_Lib_Unit_Node): Rename to Enclosing_Comp_Unit_Node.

2012-05-15  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch6.adb (Analyze_Subprogram_Body_Helper): Remove obsolete
	checks on nested inlined subprograms.

2012-05-15  Tristan Gingold  <gingold@adacore.com>

	* fe.h (Get_RT_Exception_Name): Declare.

2012-05-15  Tristan Gingold  <gingold@adacore.com>

	* raise-gcc.c (db_region_for): Use %p + cast to avoid warnings.
	(get_region_description_for): Likewise.
	(db_action_for): Likewise.
	(get_call_site_action_for): Likewise.
	(get_ttype_entry_for): Remove useless 'const'.
	(PERSONALITY_FUNCTION): Add ATTRIBUTE_UNUSED on uw_exception_class.

2012-05-15  Tristan Gingold  <gingold@adacore.com>

	* a-exextr.adb (Unhandled_Exception_Terminate): Save occurrence
	on the stack to avoid a dynamic memory allocation.

2012-05-15  Bob Duff  <duff@adacore.com>

	* exp_ch9.adb (Expand_N_Timed_Entry_Call): Move initialization of
	E_Stats and D_Stats after Process_Statements_For_Controlled_Objects,
	because those calls can destroy the Statements list.

From-SVN: r187518
parent 0c644c99
Showing with 171 additions and 138 deletions
gcc/ada/ChangeLog
2012-05-15 Robert Dewar <dewar@adacore.com>
* exp_ch7.adb, exp_ch11.adb, exp_ch11.ads: Minor reformatting.
2012-05-15 Thomas Quinot <quinot@adacore.com>
* sem_res.adb (Resolve): Enforce E.2.2(11/2) and E.2.2(12) for
'Unrestricted_Access and 'Unchecked_Access (not just 'Access):
even in those cases, a remote access type may only designate a
remote subprogram.
2012-05-15 Thomas Quinot <quinot@adacore.com>
* sem_util.adb, sem_util.ads, sem_cat.adb: Minor refactoring.
(Enclosing_Lib_Unit_Node): Rename to Enclosing_Comp_Unit_Node.
2012-05-15 Ed Schonberg <schonberg@adacore.com>
* sem_ch6.adb (Analyze_Subprogram_Body_Helper): Remove obsolete
checks on nested inlined subprograms.
2012-05-15 Tristan Gingold <gingold@adacore.com>
* fe.h (Get_RT_Exception_Name): Declare.
2012-05-15 Tristan Gingold <gingold@adacore.com>
* raise-gcc.c (db_region_for): Use %p + cast to avoid warnings.
(get_region_description_for): Likewise.
(db_action_for): Likewise.
(get_call_site_action_for): Likewise.
(get_ttype_entry_for): Remove useless 'const'.
(PERSONALITY_FUNCTION): Add ATTRIBUTE_UNUSED on uw_exception_class.
2012-05-15 Tristan Gingold <gingold@adacore.com>
* a-exextr.adb (Unhandled_Exception_Terminate): Save occurrence
on the stack to avoid a dynamic memory allocation.
2012-05-15 Bob Duff <duff@adacore.com>
* exp_ch9.adb (Expand_N_Timed_Entry_Call): Move initialization of
E_Stats and D_Stats after Process_Statements_For_Controlled_Objects,
because those calls can destroy the Statements list.
2012-05-15 Tristan Gingold <gingold@adacore.com>
* fe.h (Get_RT_Exception_Name): Define.
......
gcc/ada/a-exextr.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2011, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2012, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
......@@ -162,14 +162,15 @@ package body Exception_Traces is
-----------------------------------
procedure Unhandled_Exception_Terminate is
Excep : constant EOA := Save_Occurrence (Get_Current_Excep.all.all);
Excep : Exception_Occurrence;
-- This occurrence will be used to display a message after finalization.
-- It is necessary to save a copy here, or else the designated value
-- could be overwritten if an exception is raised during finalization
-- (even if that exception is caught).
begin
Last_Chance_Handler (Excep.all);
Save_Occurrence (Excep, Get_Current_Excep.all.all);
Last_Chance_Handler (Excep);
end Unhandled_Exception_Terminate;
------------------------------------
......
gcc/ada/exp_ch11.adb
......@@ -1909,72 +1909,78 @@ package body Exp_Ch11 is
-- case it will end up in the block statements, even though it
-- is not there now.
if Is_List_Member (N)
and then (List_Containing (N) = Statements (P)
or else
List_Containing (N) = SSE.Actions_To_Be_Wrapped_Before
or else
List_Containing (N) = SSE.Actions_To_Be_Wrapped_After)
then
-- Loop through exception handlers
if Is_List_Member (N) then
declare
LCN : constant List_Id := List_Containing (N);
H := First (Exception_Handlers (P));
while Present (H) loop
begin
if LCN = Statements (P)
or else
LCN = SSE.Actions_To_Be_Wrapped_Before
or else
LCN = SSE.Actions_To_Be_Wrapped_After
then
-- Loop through exception handlers
-- Guard against other constructs appearing in the list of
-- exception handlers.
H := First (Exception_Handlers (P));
while Present (H) loop
if Nkind (H) = N_Exception_Handler then
-- Guard against other constructs appearing in the
-- list of exception handlers.
-- Loop through choices in one handler
if Nkind (H) = N_Exception_Handler then
C := First (Exception_Choices (H));
while Present (C) loop
-- Loop through choices in one handler
-- Deal with others case
C := First (Exception_Choices (H));
while Present (C) loop
if Nkind (C) = N_Others_Choice then
-- Deal with others case
-- Matching others handler, but we need to ensure
-- there is no choice parameter. If there is, then
-- we don't have a local handler after all (since
-- we do not allow choice parameters for local
-- handlers).
if Nkind (C) = N_Others_Choice then
if No (Choice_Parameter (H)) then
return H;
else
return Empty;
end if;
-- Matching others handler, but we need
-- to ensure there is no choice parameter.
-- If there is, then we don't have a local
-- handler after all (since we do not allow
-- choice parameters for local handlers).
-- If not others must be entity name
if No (Choice_Parameter (H)) then
return H;
else
return Empty;
end if;
elsif Nkind (C) /= N_Others_Choice then
pragma Assert (Is_Entity_Name (C));
pragma Assert (Present (Entity (C)));
-- If not others must be entity name
-- Get exception being handled, dealing with
-- renaming.
elsif Nkind (C) /= N_Others_Choice then
pragma Assert (Is_Entity_Name (C));
pragma Assert (Present (Entity (C)));
EHandle := Get_Renamed_Entity (Entity (C));
-- Get exception being handled, dealing with
-- renaming.
-- If match, then check choice parameter
EHandle := Get_Renamed_Entity (Entity (C));
if ERaise = EHandle then
if No (Choice_Parameter (H)) then
return H;
else
return Empty;
-- If match, then check choice parameter
if ERaise = EHandle then
if No (Choice_Parameter (H)) then
return H;
else
return Empty;
end if;
end if;
end if;
end if;
Next (C);
end loop;
end if;
Next (C);
Next (H);
end loop;
end if;
Next (H);
end loop;
end;
end if;
end if;
......
gcc/ada/exp_ch11.ads
......@@ -79,9 +79,9 @@ package Exp_Ch11 is
-- the exception entity to be passed to Local_Raise.
procedure Get_RT_Exception_Name (Code : RT_Exception_Code);
-- This procedure is provided for use by the back end to get in the
-- name of the Rcheck procedure for Code. The name is appended to
-- Namet.Name_Buffer, without the __gnat_rcheck_ prefix.
-- This procedure is provided for use by the back end to obtain the name of
-- the Rcheck procedure for Code. The name is appended to Namet.Name_Buffer
-- without the __gnat_rcheck_ prefix.
function Is_Non_Ada_Error (E : Entity_Id) return Boolean;
-- This function is provided for Gigi use. It returns True if operating on
......
gcc/ada/exp_ch7.adb
......@@ -723,9 +723,10 @@ package body Exp_Ch7 is
pragma Assert (Present (Data.Raised_Id));
if Exception_Extra_Info
or else (For_Library and then not Restricted_Profile)
or else (For_Library and not Restricted_Profile)
then
if Exception_Extra_Info then
-- Generate:
-- Get_Current_Excep.all
......@@ -735,8 +736,9 @@ package body Exp_Ch7 is
Name =>
Make_Explicit_Dereference (Data.Loc,
Prefix =>
New_Reference_To (RTE (RE_Get_Current_Excep),
Data.Loc)));
New_Reference_To
(RTE (RE_Get_Current_Excep), Data.Loc)));
else
-- Generate:
......@@ -748,15 +750,17 @@ package body Exp_Ch7 is
if For_Library and then not Restricted_Profile then
Proc_To_Call := RTE (RE_Save_Library_Occurrence);
Actuals := New_List (Except);
else
Proc_To_Call := RTE (RE_Save_Occurrence);
-- The dereference occurs only when Exception_Extra_Info is true,
-- and therefore Except is not null.
Actuals := New_List (
New_Reference_To (Data.E_Id, Data.Loc),
Make_Explicit_Dereference (Data.Loc, Except));
Actuals :=
New_List (
New_Reference_To (Data.E_Id, Data.Loc),
Make_Explicit_Dereference (Data.Loc, Except));
end if;
-- Generate:
......@@ -3054,6 +3058,7 @@ package body Exp_Ch7 is
A_Expr := New_Reference_To (RTE (RE_Triggered_By_Abort), Loc);
-- Generate:
-- Abort_Id : constant Boolean := <A_Expr>;
Append_To (Decls,
......@@ -3073,6 +3078,7 @@ package body Exp_Ch7 is
Data.E_Id := Make_Temporary (Loc, 'E');
-- Generate:
-- E_Id : Exception_Occurrence;
E_Decl :=
......@@ -3089,6 +3095,7 @@ package body Exp_Ch7 is
end if;
-- Generate:
-- Raised_Id : Boolean := False;
Append_To (Decls,
......@@ -3134,6 +3141,7 @@ package body Exp_Ch7 is
end if;
-- Generate:
-- Raised_Id and then not Abort_Id
-- <or>
-- Raised_Id
......@@ -3149,6 +3157,7 @@ package body Exp_Ch7 is
end if;
-- Generate:
-- if Raised_Id and then not Abort_Id then
-- Raise_From_Controlled_Operation (E_Id);
-- <or>
......
gcc/ada/exp_ch9.adb
......@@ -11883,12 +11883,10 @@ package body Exp_Ch9 is
E_Call : Node_Id :=
Entry_Call_Statement (Entry_Call_Alternative (N));
E_Stats : constant List_Id :=
Statements (Entry_Call_Alternative (N));
E_Stats : List_Id; -- statements after entry call
D_Stat : Node_Id :=
Delay_Statement (Delay_Alternative (N));
D_Stats : constant List_Id :=
Statements (Delay_Alternative (N));
D_Stats : List_Id; -- statements after "delay ..."
Actuals : List_Id;
Blk_Typ : Entity_Id;
......@@ -11933,6 +11931,12 @@ package body Exp_Ch9 is
Process_Statements_For_Controlled_Objects (Entry_Call_Alternative (N));
Process_Statements_For_Controlled_Objects (Delay_Alternative (N));
-- Must fetch E_Stats/D_Stats after above "Process_...", because it
-- might modify them.
E_Stats := Statements (Entry_Call_Alternative (N));
D_Stats := Statements (Delay_Alternative (N));
-- The arguments in the call may require dynamic allocation, and the
-- call statement may have been transformed into a block. The block
-- may contain additional declarations for internal entities, and the
......
gcc/ada/fe.h
......@@ -110,6 +110,7 @@ extern Nat Serious_Errors_Detected;
extern Entity_Id Get_Local_Raise_Call_Entity (void);
extern Entity_Id Get_RT_Exception_Entity (int);
extern void Get_RT_Exception_Name (int);
/* exp_code: */
......
gcc/ada/raise-gcc.c
......@@ -6,7 +6,7 @@
* *
* C Implementation File *
* *
* Copyright (C) 1992-2011, Free Software Foundation, Inc. *
* Copyright (C) 1992-2012, Free Software Foundation, Inc. *
* *
* GNAT is free software; you can redistribute it and/or modify it under *
* terms of the GNU General Public License as published by the Free Soft- *
......@@ -535,10 +535,10 @@ db_region_for (region_descriptor *region, _Unwind_Context *uw_context)
ip = get_ip_from_context (uw_context);
db (DB_REGIONS, "For ip @ 0x%08x => ", ip);
db (DB_REGIONS, "For ip @ %p => ", (void *)ip);
if (region->lsda)
db (DB_REGIONS, "lsda @ 0x%x", region->lsda);
db (DB_REGIONS, "lsda @ %p", (void *)region->lsda);
else
db (DB_REGIONS, "no lsda");
......@@ -548,7 +548,7 @@ db_region_for (region_descriptor *region, _Unwind_Context *uw_context)
/* Retrieve the ttype entry associated with FILTER in the REGION's
ttype table. */
static const _Unwind_Ptr
static _Unwind_Ptr
get_ttype_entry_for (region_descriptor *region, long filter)
{
_Unwind_Ptr ttype_entry;
......@@ -582,7 +582,7 @@ get_region_description_for (_Unwind_Context *uw_context,
return;
/* Parse the lsda and fill the region descriptor. */
p = (char *)region->lsda;
p = (const unsigned char *)region->lsda;
region->base = _Unwind_GetRegionStart (uw_context);
......@@ -662,13 +662,13 @@ db_action_for (action_descriptor *action, _Unwind_Context *uw_context)
{
_Unwind_Ptr ip = get_ip_from_context (uw_context);
db (DB_ACTIONS, "For ip @ 0x%08x => ", ip);
db (DB_ACTIONS, "For ip @ %p => ", (void *)ip);
switch (action->kind)
{
case unknown:
db (DB_ACTIONS, "lpad @ 0x%x, record @ 0x%x\n",
action->landing_pad, action->table_entry);
db (DB_ACTIONS, "lpad @ %p, record @ %p\n",
(void *) action->landing_pad, action->table_entry);
break;
case nothing:
......@@ -680,7 +680,7 @@ db_action_for (action_descriptor *action, _Unwind_Context *uw_context)
break;
case handler:
db (DB_ACTIONS, "Handler, filter = %d\n", action->ttype_filter);
db (DB_ACTIONS, "Handler, filter = %d\n", (int) action->ttype_filter);
break;
default:
......@@ -784,9 +784,9 @@ get_call_site_action_for (_Unwind_Context *uw_context,
p = read_uleb128 (p, &cs_action);
db (DB_CSITE,
"c_site @ 0x%08x (+0x%03x), len = %3d, lpad @ 0x%08x (+0x%03x)\n",
region->base+cs_start, cs_start, cs_len,
region->lp_base+cs_lp, cs_lp);
"c_site @ %p (+%p), len = %p, lpad @ %p (+%p)\n",
(void *)region->base + cs_start, (void *)cs_start, (void *)cs_len,
(void *)region->lp_base + cs_lp, (void *)cs_lp);
/* The table is sorted, so if we've passed the IP, stop. */
if (ip < region->base + cs_start)
......@@ -1069,7 +1069,8 @@ PERSONALITY_FUNCTION (version_arg_t, phases_arg_t,
_Unwind_Reason_Code
PERSONALITY_FUNCTION (version_arg_t version_arg,
phases_arg_t phases_arg,
_Unwind_Exception_Class uw_exception_class,
_Unwind_Exception_Class uw_exception_class
ATTRIBUTE_UNUSED,
_Unwind_Exception *uw_exception,
_Unwind_Context *uw_context)
{
......
gcc/ada/sem_cat.adb
......@@ -2131,7 +2131,7 @@ package body Sem_Cat is
if Is_Internal_File_Name (Unit_File_Name (Get_Source_Unit (N)))
and then
Enclosing_Lib_Unit_Node (N) /= Enclosing_Lib_Unit_Node (E)
Enclosing_Comp_Unit_Node (N) /= Enclosing_Comp_Unit_Node (E)
and then (Is_Preelaborated (Scope (E))
or else Is_Pure (Scope (E))
or else (Present (Renamed_Object (E))
......
gcc/ada/sem_ch6.adb
......@@ -1812,7 +1812,6 @@ package body Sem_Ch6 is
Prev_Id : constant Entity_Id := Current_Entity_In_Scope (Body_Id);
Conformant : Boolean;
HSS : Node_Id;
P_Ent : Entity_Id;
Prot_Typ : Entity_Id := Empty;
Spec_Id : Entity_Id;
Spec_Decl : Node_Id := Empty;
......@@ -2507,42 +2506,10 @@ package body Sem_Ch6 is
end if;
end if;
-- Do not inline any subprogram that contains nested subprograms, since
-- the backend inlining circuit seems to generate uninitialized
-- references in this case. We know this happens in the case of front
-- end ZCX support, but it also appears it can happen in other cases as
-- well. The backend often rejects attempts to inline in the case of
-- nested procedures anyway, so little if anything is lost by this.
-- Note that this is test is for the benefit of the back-end. There is
-- a separate test for front-end inlining that also rejects nested
-- subprograms.
-- Do not do this test if errors have been detected, because in some
-- error cases, this code blows up, and we don't need it anyway if
-- there have been errors, since we won't get to the linker anyway.
if Comes_From_Source (Body_Id)
and then Serious_Errors_Detected = 0
and then not Debug_Flag_Dot_K
then
P_Ent := Body_Id;
loop
P_Ent := Scope (P_Ent);
exit when No (P_Ent) or else P_Ent = Standard_Standard;
if Is_Subprogram (P_Ent) then
Set_Is_Inlined (P_Ent, False);
if Comes_From_Source (P_Ent)
and then Has_Pragma_Inline (P_Ent)
then
Cannot_Inline
("cannot inline& (nested subprogram)?",
N, P_Ent);
end if;
end if;
end loop;
end if;
-- Previously we scanned the body to look for nested subprograms, and
-- rejected an inline directive if nested subprograms were present,
-- because the back-end would generate conflicting symbols for the
-- nested bodies. This is now unecessary.
-- Look ahead to recognize a pragma inline that appears after the body
......
gcc/ada/sem_res.adb
......@@ -1967,7 +1967,10 @@ package body Sem_Res is
-- Prefix (N) must statically denote a remote subprogram
-- declared in a package specification.
if Attr = Attribute_Access then
if Attr = Attribute_Access or else
Attr = Attribute_Unchecked_Access or else
Attr = Attribute_Unrestricted_Access
then
Decl := Unit_Declaration_Node (Entity (Pref));
if Nkind (Decl) = N_Subprogram_Body then
......@@ -1990,26 +1993,22 @@ package body Sem_Res is
("prefix must statically denote a remote subprogram ",
N);
end if;
end if;
-- If we are generating code for a distributed program.
-- perform semantic checks against the corresponding
-- remote entities.
-- If we are generating code in distributed mode, perform
-- semantic checks against corresponding remote entities.
if (Attr = Attribute_Access or else
Attr = Attribute_Unchecked_Access or else
Attr = Attribute_Unrestricted_Access)
and then Full_Expander_Active
and then Get_PCS_Name /= Name_No_DSA
then
Check_Subtype_Conformant
(New_Id => Entity (Prefix (N)),
Old_Id => Designated_Type
(Corresponding_Remote_Type (Typ)),
Err_Loc => N);
if Is_Remote then
Process_Remote_AST_Attribute (N, Typ);
if Full_Expander_Active
and then Get_PCS_Name /= Name_No_DSA
then
Check_Subtype_Conformant
(New_Id => Entity (Prefix (N)),
Old_Id => Designated_Type
(Corresponding_Remote_Type (Typ)),
Err_Loc => N);
if Is_Remote then
Process_Remote_AST_Attribute (N, Typ);
end if;
end if;
end if;
end if;
......
gcc/ada/sem_util.adb
......@@ -3165,11 +3165,11 @@ package body Sem_Util is
return Unit_Entity;
end Enclosing_Lib_Unit_Entity;
-----------------------------
-- Enclosing_Lib_Unit_Node --
-----------------------------
------------------------------
-- Enclosing_Comp_Unit_Node --
------------------------------
function Enclosing_Lib_Unit_Node (N : Node_Id) return Node_Id is
function Enclosing_Comp_Unit_Node (N : Node_Id) return Node_Id is
Current_Node : Node_Id;
begin
......@@ -3185,7 +3185,7 @@ package body Sem_Util is
end if;
return Current_Node;
end Enclosing_Lib_Unit_Node;
end Enclosing_Comp_Unit_Node;
-----------------------
-- Enclosing_Package --
......
gcc/ada/sem_util.ads
......@@ -386,7 +386,7 @@ package Sem_Util is
-- root of the current scope (which must not be Standard_Standard, and the
-- caller is responsible for ensuring this condition).
function Enclosing_Lib_Unit_Node (N : Node_Id) return Node_Id;
function Enclosing_Comp_Unit_Node (N : Node_Id) return Node_Id;
-- Returns the enclosing N_Compilation_Unit Node that is the root of a
-- subtree containing N.
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment