aboutsummaryrefslogtreecommitdiff
path: root/gcc
diff options
context:
space:
mode:
authorArnaud Charlet <charlet@gcc.gnu.org>2012-07-17 11:49:48 +0200
committerArnaud Charlet <charlet@gcc.gnu.org>2012-07-17 11:49:48 +0200
commitf080def5134dc47dcb997778a35858f208c2c393 (patch)
treeca28973deac660af91e6de4aba33237e1ac95b34 /gcc
parent2767f2cc5cc916f4a99cbfd510cf5a5454c54221 (diff)
downloadgcc-f080def5134dc47dcb997778a35858f208c2c393.zip
gcc-f080def5134dc47dcb997778a35858f208c2c393.tar.gz
gcc-f080def5134dc47dcb997778a35858f208c2c393.tar.bz2
[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
Diffstat (limited to 'gcc')
-rw-r--r--gcc/ada/ChangeLog22
-rw-r--r--gcc/ada/exp_ch3.adb2
-rw-r--r--gcc/ada/exp_ch9.adb38
-rw-r--r--gcc/ada/seh_init.c11
-rw-r--r--gcc/ada/sem_prag.adb13
-rw-r--r--gcc/ada/treepr.adb55
-rw-r--r--gcc/ada/treepr.ads6
7 files changed, 102 insertions, 45 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index a8e8203..09bd2d8 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,25 @@
+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
diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb
index e39b10d..978e1b8 100644
--- a/gcc/ada/exp_ch3.adb
+++ b/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;
diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb
index 612aebd..6f37b78 100644
--- a/gcc/ada/exp_ch9.adb
+++ b/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;
diff --git a/gcc/ada/seh_init.c b/gcc/ada/seh_init.c
index 2f7fee4..772dab0 100644
--- a/gcc/ada/seh_init.c
+++ b/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
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index dc0ae4e..72f3cf1 100644
--- a/gcc/ada/sem_prag.adb
+++ b/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;
---------------------
diff --git a/gcc/ada/treepr.adb b/gcc/ada/treepr.adb
index ed827cc..5791d3e 100644
--- a/gcc/ada/treepr.adb
+++ b/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 --
--------
diff --git a/gcc/ada/treepr.ads b/gcc/ada/treepr.ads
index 6e9541a..700f3de 100644
--- a/gcc/ada/treepr.ads
+++ b/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);