Skip to content

R
riscv-gcc-1
Commit cb25faf8 by Arnaud Charlet
Options

[multiple changes] 

2011-08-29  Robert Dewar  <dewar@adacore.com>

	* exp_ch9.adb, s-tasren.adb, exp_sel.adb, exp_sel.ads, exp_ch11.adb,
	s-interr-hwint.adb, s-tpobop.adb, sem_ch13.adb: Minor reformatting.

2011-08-29  Thomas Quinot  <quinot@adacore.com>

	* par-endh.adb (Check_End): For an END where it is mandatory to repeat
	the scope name, do not report a missing label as a style violation (it
	will be diagnosed as an illegality).
	* exp_dist.adb (Add_Params_For_Variant_Components): Fix handling of
	variant records: Get_Enum_Lit_From_Pos already returns a usage
	occurrence of the literal, no need to use New_Occurrence_Of. Set Etype
	on Expr in Integer_Literal case so that it can be used by
	Build_To_Any_Call.

From-SVN: r178195
parent 1d10f669
Showing with 70 additions and 49 deletions
gcc/ada/ChangeLog
2011-08-29 Robert Dewar <dewar@adacore.com>
* exp_ch9.adb, s-tasren.adb, exp_sel.adb, exp_sel.ads, exp_ch11.adb,
s-interr-hwint.adb, s-tpobop.adb, sem_ch13.adb: Minor reformatting.
2011-08-29 Thomas Quinot <quinot@adacore.com>
* par-endh.adb (Check_End): For an END where it is mandatory to repeat
the scope name, do not report a missing label as a style violation (it
will be diagnosed as an illegality).
* exp_dist.adb (Add_Params_For_Variant_Components): Fix handling of
variant records: Get_Enum_Lit_From_Pos already returns a usage
occurrence of the literal, no need to use New_Occurrence_Of. Set Etype
on Expr in Integer_Literal case so that it can be used by
Build_To_Any_Call.
2011-08-29 Tristan Gingold <gingold@adacore.com>
* exp_sel.ads (Build_Abort_BLock_Handler): New function spec.
......
gcc/ada/exp_ch11.adb
......@@ -1100,7 +1100,6 @@ package body Exp_Ch11 is
elsif Abort_Allowed
and then Exception_Mechanism /= Back_End_Exceptions
then
-- There are some special cases in which we do not do the
-- undefer. In particular a finalization (AT END) handler
-- wants to operate with aborts still deferred.
......
gcc/ada/exp_ch9.adb
......@@ -6487,8 +6487,7 @@ package body Exp_Ch9 is
Append_To (Stmts,
Make_Implicit_If_Statement (N,
Condition => Make_Function_Call (Loc,
Name => New_Reference_To (
RTE (RE_Enqueued), Loc),
Name => New_Reference_To (RTE (RE_Enqueued), Loc),
Parameter_Associations => New_List (
New_Reference_To (Cancel_Param, Loc))),
Then_Statements => Astats));
......@@ -6507,9 +6506,12 @@ package body Exp_Ch9 is
if VM_Target = No_VM then
if Exception_Mechanism = Back_End_Exceptions then
-- Aborts are not deferred at beginning of exception handlers
-- in ZCX.
Handler_Stmt := Make_Null_Statement (Loc);
else
Handler_Stmt := Make_Procedure_Call_Statement (Loc,
Name => New_Reference_To (RTE (RE_Abort_Undefer), Loc),
......@@ -6518,9 +6520,10 @@ package body Exp_Ch9 is
else
Handler_Stmt := Make_Procedure_Call_Statement (Loc,
Name => New_Reference_To (RTE (RE_Update_Exception), Loc),
Parameter_Associations => New_List (Make_Function_Call (Loc,
Name => New_Occurrence_Of (RTE (RE_Current_Target_Exception),
Loc))));
Parameter_Associations => New_List (
Make_Function_Call (Loc,
Name => New_Occurrence_Of
(RTE (RE_Current_Target_Exception), Loc))));
end if;
Stmts := New_List (
......
gcc/ada/exp_dist.adb
......@@ -10430,11 +10430,10 @@ package body Exp_Dist is
-- A variant part
declare
Discriminant_Type : constant Entity_Id :=
Etype (Name (Field));
Disc_Type : constant Entity_Id := Etype (Name (Field));
Is_Enum : constant Boolean :=
Is_Enumeration_Type (Discriminant_Type);
Is_Enumeration_Type (Disc_Type);
Union_TC_Params : List_Id;
......@@ -10465,8 +10464,7 @@ package body Exp_Dist is
-- Add_Params_For_Variant_Components --
---------------------------------------
procedure Add_Params_For_Variant_Components
is
procedure Add_Params_For_Variant_Components is
S_Name : constant Name_Id :=
New_External_Name (U_Name, 'S', -1);
......@@ -10510,8 +10508,7 @@ package body Exp_Dist is
-- Build union parameters
Add_TypeCode_Parameter
(Build_TypeCode_Call
(Loc, Discriminant_Type, Decls),
(Build_TypeCode_Call (Loc, Disc_Type, Decls),
Union_TC_Params);
Add_Long_Parameter (Default, Union_TC_Params);
......@@ -10536,13 +10533,13 @@ package body Exp_Dist is
begin
while J <= H loop
if Is_Enum then
Expr := New_Occurrence_Of (
Get_Enum_Lit_From_Pos (
Discriminant_Type, J, Loc), Loc);
Expr := Get_Enum_Lit_From_Pos
(Disc_Type, J, Loc);
else
Expr :=
Make_Integer_Literal (Loc, J);
end if;
Set_Etype (Expr, Disc_Type);
Append_To (Union_TC_Params,
Build_To_Any_Call (Expr, Decls));
......@@ -10553,11 +10550,10 @@ package body Exp_Dist is
when N_Others_Choice =>
-- This variant possess a default choice.
-- We must therefore set the default
-- parameter to the current choice index. The
-- default parameter is by construction the
-- fourth in the Union_TC_Params list.
-- This variant has a default choice. We must
-- therefore set the default parameter to the
-- current choice index. This parameter is by
-- construction the 4th in Union_TC_Params.
declare
Default_Node : constant Node_Id :=
......@@ -10573,25 +10569,24 @@ package body Exp_Dist is
Make_Integer_Literal
(Loc, Choice_Index)));
begin
Insert_Before (
Default_Node,
New_Default_Node);
Insert_Before
(Default_Node, New_Default_Node);
Remove (Default_Node);
end;
-- Add a placeholder member label
-- for the default case.
-- It must be of the discriminant type.
-- Add a placeholder member label for the
-- default case, which must have the
-- discriminant type.
declare
Exp : constant Node_Id :=
Make_Attribute_Reference (Loc,
Prefix => New_Occurrence_Of
(Discriminant_Type, Loc),
Prefix => New_Occurrence_Of
(Disc_Type, Loc),
Attribute_Name => Name_First);
begin
Set_Etype (Exp, Discriminant_Type);
Set_Etype (Exp, Disc_Type);
Append_To (Union_TC_Params,
Build_To_Any_Call (Exp, Decls));
end;
......
gcc/ada/exp_sel.adb
......@@ -57,10 +57,8 @@ package body Exp_Sel is
Statements =>
New_List (
Make_Implicit_Label_Declaration (Loc,
Defining_Identifier =>
Cln_Blk_Ent,
Label_Construct =>
Blk),
Defining_Identifier => Cln_Blk_Ent,
Label_Construct => Blk),
Blk),
Exception_Handlers =>
......@@ -71,29 +69,29 @@ package body Exp_Sel is
-- Build_Abort_Block_Handler --
-------------------------------
function Build_Abort_Block_Handler
(Loc : Source_Ptr) return Node_Id
is
function Build_Abort_Block_Handler (Loc : Source_Ptr) return Node_Id is
Stmt : Node_Id;
begin
if Exception_Mechanism = Back_End_Exceptions then
-- With ZCX, aborts are not defered in handlers.
-- With ZCX, aborts are not defered in handlers
Stmt := Make_Null_Statement (Loc);
else
-- With FE SJLJ, aborts are defered at the beginning of Abort_Signal
-- handlers.
Stmt := Make_Procedure_Call_Statement (Loc,
Name => New_Reference_To (RTE (RE_Abort_Undefer), Loc),
Parameter_Associations => No_List);
Stmt :=
Make_Procedure_Call_Statement (Loc,
Name => New_Reference_To (RTE (RE_Abort_Undefer), Loc),
Parameter_Associations => No_List);
end if;
return Make_Implicit_Exception_Handler (Loc,
Exception_Choices =>
New_List (New_Reference_To (Stand.Abort_Signal, Loc)),
Statements =>
New_List (Stmt));
Statements => New_List (Stmt));
end Build_Abort_Block_Handler;
-------------
......@@ -143,8 +141,9 @@ package body Exp_Sel is
is
Cleanup_Block : constant Node_Id :=
Make_Block_Statement (Loc,
Identifier => New_Reference_To (Blk_Ent, Loc),
Declarations => No_List,
Identifier =>
New_Reference_To (Blk_Ent, Loc),
Declarations => No_List,
Handled_Statement_Sequence =>
Make_Handled_Sequence_Of_Statements (Loc,
Statements => Stmts),
......
gcc/ada/exp_sel.ads
......@@ -45,8 +45,7 @@ package Exp_Sel is
-- of the encapsulated cleanup block, Blk is the actual block name.
-- The exception handler code is built by Build_Abort_Block_Handler.
function Build_Abort_Block_Handler
(Loc : Source_Ptr) return Node_Id;
function Build_Abort_Block_Handler (Loc : Source_Ptr) return Node_Id;
-- Generate if front-end exception:
-- when others =>
-- Abort_Under;
......
gcc/ada/par-endh.adb
......@@ -374,11 +374,16 @@ package body Endh is
Set_Comes_From_Source (End_Labl, False);
End_Labl_Present := False;
-- Do style check for missing label
-- Do style check for label permitted but not present. Note:
-- for the case of a block statement, the label is required
-- to be repeated, and this legality rule is enforced
-- independently.
if Style_Check
and then End_Type = E_Name
and then Explicit_Start_Label (Scope.Last)
and then Nkind (Parent (Scope.Table (Scope.Last).Labl))
/= N_Block_Statement
then
Style.No_End_Name (Scope.Table (Scope.Last).Labl);
end if;
......
gcc/ada/s-interr-hwint.adb
......@@ -1030,6 +1030,7 @@ package body System.Interrupts is
end if;
-- Flush interrupt server semaphores, so they can terminate
Finalize_Interrupt_Servers;
raise;
end Interrupt_Manager;
......
gcc/ada/s-tpobop.adb
......@@ -258,9 +258,11 @@ package body System.Tasking.Protected_Objects.Operations is
-- enabled for its remaining life.
Self_Id := STPO.Self;
if not ZCX_By_Default then
Initialization.Undefer_Abort_Nestable (Self_Id);
end if;
Transfer_Occurrence
(Entry_Call.Self.Common.Compiler_Data.Current_Excep'Access,
Self_Id.Common.Compiler_Data.Current_Excep);
......@@ -272,7 +274,9 @@ package body System.Tasking.Protected_Objects.Operations is
end if;
if Runtime_Traces then
-- ??? Entry_Call can be null
Send_Trace_Info (PO_Done, Entry_Call.Self);
end if;
end Exceptional_Complete_Entry_Body;
......
gcc/ada/sem_ch13.adb
......@@ -1544,7 +1544,7 @@ package body Sem_Ch13 is
-- has the proper type structure.
function Check_Primitive_Function (Subp : Entity_Id) return Boolean;
-- Common legality check for the previoous two
-- Common legality check for the previous two
-----------------------------------
-- Analyze_Stream_TSS_Definition --
......
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