diff options
author | Arnaud Charlet <charlet@gcc.gnu.org> | 2012-07-17 11:49:48 +0200 |
---|---|---|
committer | Arnaud Charlet <charlet@gcc.gnu.org> | 2012-07-17 11:49:48 +0200 |
commit | f080def5134dc47dcb997778a35858f208c2c393 (patch) | |
tree | ca28973deac660af91e6de4aba33237e1ac95b34 /gcc | |
parent | 2767f2cc5cc916f4a99cbfd510cf5a5454c54221 (diff) | |
download | gcc-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/ChangeLog | 22 | ||||
-rw-r--r-- | gcc/ada/exp_ch3.adb | 2 | ||||
-rw-r--r-- | gcc/ada/exp_ch9.adb | 38 | ||||
-rw-r--r-- | gcc/ada/seh_init.c | 11 | ||||
-rw-r--r-- | gcc/ada/sem_prag.adb | 13 | ||||
-rw-r--r-- | gcc/ada/treepr.adb | 55 | ||||
-rw-r--r-- | gcc/ada/treepr.ads | 6 |
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); |