Skip to content

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

[multiple changes] 

2012-07-17  Robert Dewar  <dewar@adacore.com>

	* exp_ch9.adb: Minor code reorganization.
	* exp_ch3.adb: Minor code improvement.

2012-07-17  Tristan Gingold  <gingold@adacore.com>

	* seh_init.c (__gnat_SEH_error_handler): Not compiled anymore
	on Windows 64 (+ SEH), as it is unused.

2012-07-17  Tristan Gingold  <gingold@adacore.com>

	* treepr.ads (psloc): Declare.
	* treepr.adb (psloc): New debug procedure to print a sloc.
	(Print_Sloc): New procedure, from ...
	(Print_Node_Subtree): ... this.  Call Print_Sloc.

2012-07-17  Javier Miranda  <miranda@adacore.com>

	* sem_prag.adb (CPP_Class): Transform obsolescent pragma CPP_Class into
	CPP convention automatically.

From-SVN: r189566
parent 2767f2cc
Showing with 102 additions and 45 deletions
gcc/ada/ChangeLog
2012-07-17 Robert Dewar <dewar@adacore.com>
* exp_ch9.adb: Minor code reorganization.
* exp_ch3.adb: Minor code improvement.
2012-07-17 Tristan Gingold <gingold@adacore.com>
* seh_init.c (__gnat_SEH_error_handler): Not compiled anymore
on Windows 64 (+ SEH), as it is unused.
2012-07-17 Tristan Gingold <gingold@adacore.com>
* treepr.ads (psloc): Declare.
* treepr.adb (psloc): New debug procedure to print a sloc.
(Print_Sloc): New procedure, from ...
(Print_Node_Subtree): ... this. Call Print_Sloc.
2012-07-17 Javier Miranda <miranda@adacore.com>
* sem_prag.adb (CPP_Class): Transform obsolescent pragma CPP_Class into
CPP convention automatically.
2012-07-16 Tristan Gingold <gingold@adacore.com>
* gcc-interface/decl.c (intrin_return_compatible_p): Map Address to
......
gcc/ada/exp_ch3.adb
......@@ -3128,7 +3128,7 @@ package body Exp_Ch3 is
-- to make it a valid Ada tree.
if Is_Empty_List (Stmts) then
Append (New_Node (N_Null_Statement, Loc), Stmts);
Append (Make_Null_Statement (Loc), Stmts);
end if;
return Stmts;
......
gcc/ada/exp_ch9.adb
......@@ -5486,7 +5486,7 @@ package body Exp_Ch9 is
procedure Ensure_Statement_Present (Loc : Source_Ptr; Alt : Node_Id) is
begin
if Opt.Suppress_Control_Flow_Optimizations
and then Is_Empty_List (Statements (Alt))
and then Is_Empty_List (Statements (Alt))
then
Set_Statements (Alt, New_List (Make_Null_Statement (Loc)));
end if;
......@@ -7674,7 +7674,6 @@ package body Exp_Ch9 is
if Present (Unpack) then
Append_To (Conc_Typ_Stmts,
Make_Implicit_If_Statement (N,
Condition =>
Make_Or_Else (Loc,
Left_Opnd =>
......@@ -7684,6 +7683,7 @@ package body Exp_Ch9 is
Right_Opnd =>
New_Reference_To (RTE (
RE_POK_Protected_Entry), Loc)),
Right_Opnd =>
Make_Op_Eq (Loc,
Left_Opnd =>
......@@ -7691,8 +7691,7 @@ package body Exp_Ch9 is
Right_Opnd =>
New_Reference_To (RTE (RE_POK_Task_Entry), Loc))),
Then_Statements =>
Unpack));
Then_Statements => Unpack));
end if;
-- Generate:
......@@ -10299,31 +10298,29 @@ package body Exp_Ch9 is
Index : Int;
Proc : Node_Id)
is
Choices : List_Id := No_List;
Astmt : constant Node_Id := Accept_Statement (Alt);
Choices : List_Id;
Alt_Stats : List_Id;
begin
Adjust_Condition (Condition (Alt));
Alt_Stats := No_List;
Choices := New_List (Make_Integer_Literal (Loc, Index));
if Present (Handled_Statement_Sequence (Astmt)) then
Choices := New_List (
Make_Integer_Literal (Loc, Index));
Alt_Stats := New_List (
Make_Procedure_Call_Statement (Sloc (Proc),
Name => New_Reference_To (
Defining_Unit_Name (Specification (Proc)), Sloc (Proc))));
end if;
-- Accept with body
if No (Alt_Stats) then
-- Accept with no body, followed by trailing statements
if Present (Handled_Statement_Sequence (Astmt)) then
Alt_Stats :=
New_List (
Make_Procedure_Call_Statement (Sloc (Proc),
Name =>
New_Reference_To
(Defining_Unit_Name (Specification (Proc)),
Sloc (Proc))));
Choices := New_List (Make_Integer_Literal (Loc, Index));
-- Accept with no body (followed by trailing statements)
Alt_Stats := New_List;
else
Alt_Stats := Empty_List;
end if;
Ensure_Statement_Present (Sloc (Astmt), Alt);
......@@ -10339,6 +10336,7 @@ package body Exp_Ch9 is
Append_To (Trailing_List,
Make_Goto_Statement (Loc,
Name => New_Copy (Identifier (End_Lab))));
else
Lab := End_Lab;
end if;
......
gcc/ada/seh_init.c
......@@ -169,9 +169,11 @@ __gnat_map_SEH (EXCEPTION_RECORD* ExceptionRecord, const char **msg)
}
}
#if !(defined (_WIN64) && defined (__SEH__))
EXCEPTION_DISPOSITION
__gnat_SEH_error_handler (struct _EXCEPTION_RECORD* ExceptionRecord,
void *EstablisherFrame,
void *EstablisherFrame ATTRIBUTE_UNUSED,
struct _CONTEXT* ContextRecord ATTRIBUTE_UNUSED,
void *DispatcherContext ATTRIBUTE_UNUSED)
{
......@@ -182,14 +184,8 @@ __gnat_SEH_error_handler (struct _EXCEPTION_RECORD* ExceptionRecord,
if (exception == NULL)
{
#if defined (_WIN64) && defined (__SEH__)
/* On Windows x64, do not transform other exception as they could
be caught by user (when SEH is used to propagate exceptions). */
return;
#else
exception = &program_error;
msg = "unhandled signal";
#endif
}
#if ! defined (_WIN64)
......@@ -204,6 +200,7 @@ __gnat_SEH_error_handler (struct _EXCEPTION_RECORD* ExceptionRecord,
Raise_From_Signal_Handler (exception, msg);
return 0; /* This is never reached, avoid compiler warning */
}
#endif /* !(defined (_WIN64) && defined (__SEH__)) */
#if defined (_WIN64)
/* On x86_64 windows exception mechanism is no more based on a chained list
......
gcc/ada/sem_prag.adb
......@@ -7665,6 +7665,19 @@ package body Sem_Prag is
("'G'N'A'T pragma cpp'_class is now obsolete and has no " &
"effect; replace it by pragma import?", N);
end if;
Check_Arg_Count (1);
Rewrite (N,
Make_Pragma (Loc,
Chars => Name_Import,
Pragma_Argument_Associations =>
New_List (
Make_Pragma_Argument_Association (Loc,
Expression => Make_Identifier (Loc, Name_CPP)),
New_Copy
(First (Pragma_Argument_Associations (N))))));
Analyze (N);
end CPP_Class;
---------------------
......
gcc/ada/treepr.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- --
......@@ -188,6 +188,9 @@ package body Treepr is
-- level and the bars used to link list elements). In addition, for lines
-- other than the first, an additional character Prefix_Char is output.
procedure Print_Sloc (Loc : Source_Ptr);
-- Print the human readable representation of Loc
function Serial_Number (Id : Int) return Nat;
-- Given a Node_Id, List_Id or Elist_Id, returns the previously assigned
-- serial number, or zero if no serial number has yet been assigned.
......@@ -887,7 +890,6 @@ package body Treepr is
Field_To_Be_Printed : Boolean;
Prefix_Str_Char : String (Prefix_Str'First .. Prefix_Str'Last + 1);
Sfile : Source_File_Index;
Fmt : UI_Format;
begin
......@@ -933,20 +935,7 @@ package body Treepr is
Print_Str (Prefix_Str_Char);
Print_Str ("Sloc = ");
if Sloc (N) = Standard_Location then
Print_Str ("Standard_Location");
elsif Sloc (N) = Standard_ASCII_Location then
Print_Str ("Standard_ASCII_Location");
else
Sfile := Get_Source_File_Index (Sloc (N));
Print_Int (Int (Sloc (N)) - Int (Source_Text (Sfile)'First));
Write_Str (" ");
Write_Location (Sloc (N));
end if;
Print_Eol;
Print_Sloc (Sloc (N));
end if;
-- Print Chars field if present
......@@ -1397,6 +1386,30 @@ package body Treepr is
Print_Term;
end Print_Node_Subtree;
----------------
-- Print_Sloc --
----------------
procedure Print_Sloc (Loc : Source_Ptr) is
Sfile : Source_File_Index;
begin
if Loc = Standard_Location then
Print_Str ("Standard_Location");
elsif Loc = Standard_ASCII_Location then
Print_Str ("Standard_ASCII_Location");
else
Sfile := Get_Source_File_Index (Loc);
Print_Int (Int (Loc) - Int (Source_Text (Sfile)'First));
Write_Str (" ");
Write_Location (Loc);
end if;
Print_Eol;
end Print_Sloc;
---------------
-- Print_Str --
---------------
......@@ -1524,6 +1537,16 @@ package body Treepr is
Print_Node (N, Label, ' ');
end Print_Tree_Node;
-----------
-- psloc --
-----------
procedure psloc (Loc : Source_Ptr) is
begin
Phase := Printing;
Print_Sloc (Loc);
end psloc;
--------
-- pt --
--------
......
gcc/ada/treepr.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- 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- --
......@@ -71,6 +71,10 @@ package Treepr is
pragma Export (Ada, ppp);
-- Same as Print_Node_Subtree
procedure psloc (Loc : Source_Ptr);
pragma Export (Ada, psloc);
-- Prints the sloc Loc
-- The following are no longer needed; you can use pp or ppp instead
procedure pe (E : Elist_Id);
......
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