From 7ab4d95af734d904c16bf4af815e8810546feff6 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Thu, 4 Aug 2011 10:59:17 +0200 Subject: [PATCH] [multiple changes] 2011-08-04 Tristan Gingold * s-taprop-vxworks.adb (Enter_Task): Use System.Float_Control.Reset instead of the locally imported procedure. * s-taprop-mingw.adb (Enter_Task): Ditto. * s-valrea.adb (Scan_Real): Ditto. * s-imgrea.adb (Set_Image_Real): Ditto. * s-flocon.ads: Make the package pure. 2011-08-04 Thomas Quinot * sinfo.ads, sinfo.adb (Debug_Statement, Set_Debug_Statement): Remove. * tbuild.ads, tbuild.adb (Make_Pragma): Adjust accordingly. * sinfo-cn.ads, sinfo-cn.adb (Change_Name_To_Procedure_Call_Statement): New subprogram, moved here from... * par.adb, par-ch5.adb (P_Statement_Name): ... here. * par-prag.adb (Par.Prag, case Pragma_Debug): Do not perform any rewriting of the last argument into a procedure call statement here... * sem_prag.adb (Analyze_Pragma, case Pragma_Debug): ...do it there instead. 2011-08-04 Thomas Quinot * par_sco.adb: Minor reformatting. From-SVN: r177337 --- gcc/ada/ChangeLog | 25 +++++++++++ gcc/ada/par-ch5.adb | 86 ++++++------------------------------ gcc/ada/par-prag.adb | 32 ++------------ gcc/ada/par.adb | 6 +-- gcc/ada/par_sco.adb | 18 ++++---- gcc/ada/s-flocon.ads | 3 ++ gcc/ada/s-imgrea.adb | 19 ++++---- gcc/ada/s-taprop-mingw.adb | 12 ++--- gcc/ada/s-taprop-vxworks.adb | 9 ++-- gcc/ada/s-valrea.adb | 19 ++++---- gcc/ada/sem_prag.adb | 41 ++++++++++++++--- gcc/ada/sinfo-cn.adb | 57 +++++++++++++++++++++++- gcc/ada/sinfo-cn.ads | 7 ++- gcc/ada/sinfo.adb | 16 ------- gcc/ada/sinfo.ads | 20 +-------- gcc/ada/tbuild.adb | 4 +- gcc/ada/tbuild.ads | 5 +-- 17 files changed, 183 insertions(+), 196 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 0bf95191e56..9a4c24bb71b 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,28 @@ +2011-08-04 Tristan Gingold + + * s-taprop-vxworks.adb (Enter_Task): Use System.Float_Control.Reset + instead of the locally imported procedure. + * s-taprop-mingw.adb (Enter_Task): Ditto. + * s-valrea.adb (Scan_Real): Ditto. + * s-imgrea.adb (Set_Image_Real): Ditto. + * s-flocon.ads: Make the package pure. + +2011-08-04 Thomas Quinot + + * sinfo.ads, sinfo.adb (Debug_Statement, Set_Debug_Statement): Remove. + * tbuild.ads, tbuild.adb (Make_Pragma): Adjust accordingly. + * sinfo-cn.ads, sinfo-cn.adb (Change_Name_To_Procedure_Call_Statement): + New subprogram, moved here from... + * par.adb, par-ch5.adb (P_Statement_Name): ... here. + * par-prag.adb (Par.Prag, case Pragma_Debug): Do not perform any + rewriting of the last argument into a procedure call statement here... + * sem_prag.adb (Analyze_Pragma, case Pragma_Debug): ...do it there + instead. + +2011-08-04 Thomas Quinot + + * par_sco.adb: Minor reformatting. + 2011-08-04 Robert Dewar * erroutc.adb: Minor reformatting. diff --git a/gcc/ada/par-ch5.adb b/gcc/ada/par-ch5.adb index 373da1ff6d6..fcfb428d1f8 100644 --- a/gcc/ada/par-ch5.adb +++ b/gcc/ada/par-ch5.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2010, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2011, 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- -- @@ -24,8 +24,10 @@ ------------------------------------------------------------------------------ pragma Style_Checks (All_Checks); --- Turn off subprogram body ordering check. Subprograms are in order --- by RM section rather than alphabetical +-- Turn off subprogram body ordering check. Subprograms are in order by RM +-- section rather than alphabetical. + +with Sinfo.CN; use Sinfo.CN; separate (Par) package body Ch5 is @@ -499,8 +501,8 @@ package body Ch5 is -- we want to speed up as much as possible. elsif Token = Tok_Semicolon then - Append_To (Statement_List, - P_Statement_Name (Id_Node)); + Change_Name_To_Procedure_Call_Statement (Id_Node); + Append_To (Statement_List, Id_Node); Scan; -- past semicolon Statement_Required := False; @@ -652,8 +654,8 @@ package body Ch5 is -- means that the item we just scanned was a call. elsif Token = Tok_Semicolon then - Append_To (Statement_List, - P_Statement_Name (Name_Node)); + Change_Name_To_Procedure_Call_Statement (Name_Node); + Append_To (Statement_List, Name_Node); Scan; -- past semicolon Statement_Required := False; @@ -727,8 +729,8 @@ package body Ch5 is -- call with no parameters. if Token_Is_At_Start_Of_Line then - Append_To (Statement_List, - P_Statement_Name (Id_Node)); + Change_Name_To_Procedure_Call_Statement (Id_Node); + Append_To (Statement_List, Id_Node); T_Semicolon; -- to give error message Statement_Required := False; @@ -769,8 +771,8 @@ package body Ch5 is Append_To (Statement_List, P_Assignment_Statement (Name_Node)); else - Append_To (Statement_List, - P_Statement_Name (Name_Node)); + Change_Name_To_Procedure_Call_Statement (Name_Node); + Append_To (Statement_List, Name_Node); end if; TF_Semicolon; @@ -954,68 +956,6 @@ package body Ch5 is -- 5.1 Statement -- -------------------- - -- Parsed by P_Sequence_Of_Statements (5.1), except for the case - -- of a statement of the form of a name, which is handled here. The - -- argument passed in is the tree for the name which has been scanned - -- The returned value is the corresponding statement form. - - -- This routine is also used by Par.Prag for processing the procedure - -- call that appears as the second argument of a pragma Assert. - - -- Error recovery: cannot raise Error_Resync - - function P_Statement_Name (Name_Node : Node_Id) return Node_Id is - Stmt_Node : Node_Id; - - begin - -- Case of Indexed component, which is a procedure call with arguments - - if Nkind (Name_Node) = N_Indexed_Component then - declare - Prefix_Node : constant Node_Id := Prefix (Name_Node); - Exprs_Node : constant List_Id := Expressions (Name_Node); - - begin - Change_Node (Name_Node, N_Procedure_Call_Statement); - Set_Name (Name_Node, Prefix_Node); - Set_Parameter_Associations (Name_Node, Exprs_Node); - return Name_Node; - end; - - -- Case of function call node, which is a really a procedure call - - elsif Nkind (Name_Node) = N_Function_Call then - declare - Fname_Node : constant Node_Id := Name (Name_Node); - Params_List : constant List_Id := - Parameter_Associations (Name_Node); - - begin - Change_Node (Name_Node, N_Procedure_Call_Statement); - Set_Name (Name_Node, Fname_Node); - Set_Parameter_Associations (Name_Node, Params_List); - return Name_Node; - end; - - -- Case of call to attribute that denotes a procedure. Here we - -- just leave the attribute reference unchanged. - - elsif Nkind (Name_Node) = N_Attribute_Reference - and then Is_Procedure_Attribute_Name (Attribute_Name (Name_Node)) - then - return Name_Node; - - -- All other cases of names are parameterless procedure calls - - else - Stmt_Node := - New_Node (N_Procedure_Call_Statement, Sloc (Name_Node)); - Set_Name (Stmt_Node, Name_Node); - return Stmt_Node; - end if; - - end P_Statement_Name; - --------------------------- -- 5.1 Simple Statement -- --------------------------- diff --git a/gcc/ada/par-prag.adb b/gcc/ada/par-prag.adb index f1320ec554e..e34d99f8439 100644 --- a/gcc/ada/par-prag.adb +++ b/gcc/ada/par-prag.adb @@ -358,42 +358,16 @@ begin -- Debug -- ----------- - -- pragma Debug (PROCEDURE_CALL_STATEMENT); + -- pragma Debug ([boolean_EXPRESSION,] PROCEDURE_CALL_STATEMENT); - -- This has to be processed by the parser because of the very peculiar - -- form of the second parameter, which is syntactically from a formal - -- point of view a function call (since it must be an expression), but - -- semantically we treat it as a procedure call (which has exactly the - -- same syntactic form, so that's why we can get away with this!) - - when Pragma_Debug => Debug : declare - Expr : Node_Id; + when Pragma_Debug => + Check_No_Identifier (Arg1); - begin if Arg_Count = 2 then - Check_No_Identifier (Arg1); Check_No_Identifier (Arg2); - Expr := New_Copy (Expression (Arg2)); - else Check_Arg_Count (1); - Check_No_Identifier (Arg1); - Expr := New_Copy (Expression (Arg1)); - end if; - - if Nkind (Expr) /= N_Indexed_Component - and then Nkind (Expr) /= N_Function_Call - and then Nkind (Expr) /= N_Identifier - and then Nkind (Expr) /= N_Selected_Component - then - Error_Msg - ("argument of pragma% is not procedure call", Sloc (Expr)); - raise Error_Resync; - else - Set_Debug_Statement - (Pragma_Node, P_Statement_Name (Expr)); end if; - end Debug; ------------------------------- -- Extensions_Allowed (GNAT) -- diff --git a/gcc/ada/par.adb b/gcc/ada/par.adb index 1f5eb5797bd..32276c5084b 100644 --- a/gcc/ada/par.adb +++ b/gcc/ada/par.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2010, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2011, 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- -- @@ -723,10 +723,6 @@ function Par (Configuration_Pragmas : Boolean) return List_Id is function P_Loop_Parameter_Specification return Node_Id; -- Used in loop constructs and quantified expressions. - function P_Statement_Name (Name_Node : Node_Id) return Node_Id; - -- Given a node representing a name (which is a call), converts it - -- to the syntactically corresponding procedure call statement. - function P_Sequence_Of_Statements (SS_Flags : SS_Rec) return List_Id; -- The argument indicates the acceptable termination tokens. -- See body in Par.Ch5 for details of the use of this parameter. diff --git a/gcc/ada/par_sco.adb b/gcc/ada/par_sco.adb index af953771f20..b4d2a83925c 100644 --- a/gcc/ada/par_sco.adb +++ b/gcc/ada/par_sco.adb @@ -103,11 +103,11 @@ package body Par_SCO is procedure Process_Decisions (N : Node_Id; T : Character); -- If N is Empty, has no effect. Otherwise scans the tree for the node N, - -- to output any decisions it contains. T is one of IEPWX (for context of - -- expression: if/exit when/pragma/while/expression). If T is other than X, - -- the node N is the conditional expression involved, and a decision is - -- always present (at the very least a simple decision is present at the - -- top level). + -- to output any decisions it contains. T is one of IEGPWX (for context of + -- expression: if/exit when/entry guard/pragma/while/expression). If T is + -- other than X, the node N is the conditional expression involved, and a + -- decision is always present (at the very least a simple decision is + -- present at the top level). procedure Process_Decisions (L : List_Id; T : Character); -- Calls above procedure for each element of the list L @@ -521,8 +521,8 @@ package body Par_SCO is begin case Nkind (N) is - -- Logical operators, output table entries and then process - -- operands recursively to deal with nested conditions. + -- Logical operators, output table entries and then process + -- operands recursively to deal with nested conditions. when N_And_Then | N_Or_Else | @@ -575,7 +575,7 @@ package body Par_SCO is when N_Case_Expression => return OK; -- ??? - -- Conditional expression, processed like an if statement + -- Conditional expression, processed like an IF statement when N_Conditional_Expression => declare @@ -654,7 +654,7 @@ package body Par_SCO is procedure Debug_Put_SCOs is new Put_SCOs; - -- Start of processing for pscos + -- Start of processing for pscos begin Debug_Put_SCOs; diff --git a/gcc/ada/s-flocon.ads b/gcc/ada/s-flocon.ads index 5741efd90a0..c2374041877 100644 --- a/gcc/ada/s-flocon.ads +++ b/gcc/ada/s-flocon.ads @@ -32,6 +32,9 @@ -- Control functions for floating-point unit package System.Float_Control is + pragma Pure; + -- This is not fully correct, but this unit is with-ed by pure units + -- (eg s-imgrea). procedure Reset; -- Reset the floating-point processor to the default state needed to get diff --git a/gcc/ada/s-imgrea.adb b/gcc/ada/s-imgrea.adb index 1415a8b80f6..5c5cbef24b7 100644 --- a/gcc/ada/s-imgrea.adb +++ b/gcc/ada/s-imgrea.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2009, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2011, 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- -- @@ -33,6 +33,7 @@ with System.Img_LLU; use System.Img_LLU; with System.Img_Uns; use System.Img_Uns; with System.Powten_Table; use System.Powten_Table; with System.Unsigned_Types; use System.Unsigned_Types; +with System.Float_Control; package body System.Img_Real is @@ -143,14 +144,6 @@ package body System.Img_Real is Aft : Natural; Exp : Natural) is - procedure Reset; - pragma Import (C, Reset, "__gnat_init_float"); - -- We import the floating-point processor reset routine so that we can - -- be sure the floating-point processor is properly set for conversion - -- calls (see description of Reset in GNAT.Float_Control (g-flocon.ads). - -- This is notably need on Windows, where calls to the operating system - -- randomly reset the processor into 64-bit mode. - NFrac : constant Natural := Natural'Max (Aft, 1); Sign : Character; X : aliased Long_Long_Float; @@ -476,7 +469,13 @@ package body System.Img_Real is -- Start of processing for Set_Image_Real begin - Reset; + -- We call the floating-point processor reset routine so that we can + -- be sure the floating-point processor is properly set for conversion + -- calls. This is notably need on Windows, where calls to the operating + -- system randomly reset the processor into 64-bit mode. + + System.Float_Control.Reset; + Scale := 0; -- Deal with invalid values first, diff --git a/gcc/ada/s-taprop-mingw.adb b/gcc/ada/s-taprop-mingw.adb index 20568ce1c58..cbde1f4c90e 100644 --- a/gcc/ada/s-taprop-mingw.adb +++ b/gcc/ada/s-taprop-mingw.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2010, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2011, Free Software Foundation, Inc. -- -- -- -- GNARL 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- -- @@ -49,6 +49,7 @@ with System.OS_Primitives; with System.Task_Info; with System.Interrupt_Management; with System.Win32.Ext; +with System.Float_Control; with System.Soft_Links; -- We use System.Soft_Links instead of System.Tasking.Initialization because @@ -791,16 +792,15 @@ package body System.Task_Primitives.Operations is -- System.Task_Primitives.Operations.Create_Task during thread creation. procedure Enter_Task (Self_ID : Task_Id) is - procedure Init_Float; - pragma Import (C, Init_Float, "__gnat_init_float"); - -- Properly initializes the FPU for x86 systems - procedure Get_Stack_Bounds (Base : Address; Limit : Address); pragma Import (C, Get_Stack_Bounds, "__gnat_get_stack_bounds"); -- Get stack boundaries begin Specific.Set (Self_ID); - Init_Float; + + -- Properly initializes the FPU for x86 systems + + System.Float_Control.Reset; if Self_ID.Common.Task_Info /= null and then diff --git a/gcc/ada/s-taprop-vxworks.adb b/gcc/ada/s-taprop-vxworks.adb index f94e3886742..e1f3986e2a5 100644 --- a/gcc/ada/s-taprop-vxworks.adb +++ b/gcc/ada/s-taprop-vxworks.adb @@ -46,6 +46,7 @@ with Interfaces.C; with System.Multiprocessors; with System.Tasking.Debug; with System.Interrupt_Management; +with System.Float_Control; with System.Soft_Links; -- We use System.Soft_Links instead of System.Tasking.Initialization @@ -793,10 +794,6 @@ package body System.Task_Primitives.Operations is ---------------- procedure Enter_Task (Self_ID : Task_Id) is - procedure Init_Float; - pragma Import (C, Init_Float, "__gnat_init_float"); - -- Properly initializes the FPU for PPC/MIPS systems - begin -- Store the user-level task id in the Thread field (to be used -- internally by the run-time system) and the kernel-level task id in @@ -807,7 +804,9 @@ package body System.Task_Primitives.Operations is Specific.Set (Self_ID); - Init_Float; + -- Properly initializes the FPU for PPC/MIPS systems + + System.Float_Control.Reset; -- Install the signal handlers diff --git a/gcc/ada/s-valrea.adb b/gcc/ada/s-valrea.adb index 40c5abbca8b..00c6e43a3df 100644 --- a/gcc/ada/s-valrea.adb +++ b/gcc/ada/s-valrea.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2009, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2011, 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- -- @@ -31,6 +31,7 @@ with System.Powten_Table; use System.Powten_Table; with System.Val_Util; use System.Val_Util; +with System.Float_Control; package body System.Val_Real is @@ -43,14 +44,6 @@ package body System.Val_Real is Ptr : not null access Integer; Max : Integer) return Long_Long_Float is - procedure Reset; - pragma Import (C, Reset, "__gnat_init_float"); - -- We import the floating-point processor reset routine so that we can - -- be sure the floating-point processor is properly set for conversion - -- calls (see description of Reset in GNAT.Float_Control (g-flocon.ads). - -- This is notably need on Windows, where calls to the operating system - -- randomly reset the processor into 64-bit mode. - P : Integer; -- Local copy of string pointer @@ -173,7 +166,13 @@ package body System.Val_Real is -- Start of processing for System.Scan_Real begin - Reset; + -- We call the floating-point processor reset routine so that we can + -- be sure the floating-point processor is properly set for conversion + -- calls. This is notably need on Windows, where calls to the operating + -- system randomly reset the processor into 64-bit mode. + + System.Float_Control.Reset; + Scan_Sign (Str, Ptr, Max, Minus, Start); P := Ptr.all; Ptr.all := Start; diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 721b54e862e..13a63870766 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -7430,7 +7430,8 @@ package body Sem_Prag is -- pragma Debug ([boolean_EXPRESSION,] PROCEDURE_CALL_STATEMENT); when Pragma_Debug => Debug : declare - Cond : Node_Id; + Cond : Node_Id; + Call : Node_Id; begin GNAT_Pragma; @@ -7443,8 +7444,39 @@ package body Sem_Prag is if Arg_Count = 2 then Cond := Make_And_Then (Loc, - Left_Opnd => Relocate_Node (Cond), - Right_Opnd => Get_Pragma_Arg (Arg1)); + Left_Opnd => Relocate_Node (Cond), + Right_Opnd => Get_Pragma_Arg (Arg1)); + Call := Get_Pragma_Arg (Arg2); + else + Call := Get_Pragma_Arg (Arg1); + end if; + + if Nkind_In (Call, + N_Indexed_Component, + N_Function_Call, + N_Identifier, + N_Selected_Component) + then + -- If this pragma Debug comes from source, its argument was + -- parsed as a name form (which is syntactically identical). + -- Change it to a procedure call statement now. + + Change_Name_To_Procedure_Call_Statement (Call); + + elsif Nkind (Call) = N_Procedure_Call_Statement then + + -- Already in the form of a procedure call statement: nothing + -- to do (could happen in case of an internally generated + -- pragma Debug). + + null; + + else + -- All other cases: diagnose error + + Error_Msg + ("argument of pragma% is not procedure call", Sloc (Call)); + return; end if; -- Rewrite into a conditional with an appropriate condition. We @@ -7458,8 +7490,7 @@ package body Sem_Prag is Make_Block_Statement (Loc, Handled_Statement_Sequence => Make_Handled_Sequence_Of_Statements (Loc, - Statements => New_List ( - Relocate_Node (Debug_Statement (N)))))))); + Statements => New_List (Relocate_Node (Call))))))); Analyze (N); end Debug; diff --git a/gcc/ada/sinfo-cn.adb b/gcc/ada/sinfo-cn.adb index 2b4eaa2d961..69b4705ba25 100644 --- a/gcc/ada/sinfo-cn.adb +++ b/gcc/ada/sinfo-cn.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2008, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2011, 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- -- @@ -30,7 +30,8 @@ -- general manner, but in some specific cases, the fields of related nodes -- have been deliberately layed out in a manner that permits such alteration. -with Atree; use Atree; +with Atree; use Atree; +with Snames; use Snames; package body Sinfo.CN is @@ -74,6 +75,58 @@ package body Sinfo.CN is N := Extend_Node (N); end Change_Identifier_To_Defining_Identifier; + --------------------------------------------- + -- Change_Name_To_Procedure_Call_Statement -- + --------------------------------------------- + + procedure Change_Name_To_Procedure_Call_Statement (N : Node_Id) is + begin + -- Case of Indexed component, which is a procedure call with arguments + + if Nkind (N) = N_Indexed_Component then + declare + Prefix_Node : constant Node_Id := Prefix (N); + Exprs_Node : constant List_Id := Expressions (N); + + begin + Change_Node (N, N_Procedure_Call_Statement); + Set_Name (N, Prefix_Node); + Set_Parameter_Associations (N, Exprs_Node); + end; + + -- Case of function call node, which is a really a procedure call + + elsif Nkind (N) = N_Function_Call then + declare + Fname_Node : constant Node_Id := Name (N); + Params_List : constant List_Id := Parameter_Associations (N); + + begin + Change_Node (N, N_Procedure_Call_Statement); + Set_Name (N, Fname_Node); + Set_Parameter_Associations (N, Params_List); + end; + + -- Case of call to attribute that denotes a procedure. Here we just + -- leave the attribute reference unchanged. + + elsif Nkind (N) = N_Attribute_Reference + and then Is_Procedure_Attribute_Name (Attribute_Name (N)) + then + null; + + -- All other cases of names are parameterless procedure calls + + else + declare + Name_Node : constant Node_Id := Relocate_Node (N); + begin + Change_Node (N, N_Procedure_Call_Statement); + Set_Name (N, Name_Node); + end; + end if; + end Change_Name_To_Procedure_Call_Statement; + -------------------------------------------------------- -- Change_Operator_Symbol_To_Defining_Operator_Symbol -- -------------------------------------------------------- diff --git a/gcc/ada/sinfo-cn.ads b/gcc/ada/sinfo-cn.ads index 6460e6c7f4d..c6988f466f2 100644 --- a/gcc/ada/sinfo-cn.ads +++ b/gcc/ada/sinfo-cn.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2007, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2011, 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- -- @@ -65,4 +65,9 @@ package Sinfo.CN is -- on return the Chars field is set to a copy of the contents of the -- Chars field of the Selector_Name field. + procedure Change_Name_To_Procedure_Call_Statement (N : Node_Id); + -- Some statements (procedure call statements) are in the form of a name + -- and are parsed as such. This routine takes the scanned name as input + -- and returns the corresponding N_Procedure_Call_Statement. + end Sinfo.CN; diff --git a/gcc/ada/sinfo.adb b/gcc/ada/sinfo.adb index 40d8dd6aecd..b225b6b82fb 100644 --- a/gcc/ada/sinfo.adb +++ b/gcc/ada/sinfo.adb @@ -661,14 +661,6 @@ package body Sinfo is return Node5 (N); end Dcheck_Function; - function Debug_Statement - (N : Node_Id) return Node_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Pragma); - return Node3 (N); - end Debug_Statement; - function Declarations (N : Node_Id) return List_Id is begin @@ -3712,14 +3704,6 @@ package body Sinfo is Set_Node5 (N, Val); -- semantic field, no parent set end Set_Dcheck_Function; - procedure Set_Debug_Statement - (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Pragma); - Set_Node3_With_Parent (N, Val); - end Set_Debug_Statement; - procedure Set_Declarations (N : Node_Id; Val : List_Id) is begin diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads index 7ee9a80a550..ad81c77f841 100644 --- a/gcc/ada/sinfo.ads +++ b/gcc/ada/sinfo.ads @@ -764,15 +764,6 @@ package Sinfo is -- This field is present in an N_Variant node, It references the entity -- for the discriminant checking function for the variant. - -- Debug_Statement (Node3) - -- This field is present in an N_Pragma node. It is used only for a Debug - -- pragma. The parameter is of the form of an expression, as required by - -- the pragma syntax, but is actually a procedure call. To simplify - -- semantic processing, the parser creates a copy of the argument - -- rearranged into a procedure call statement and places it in the - -- Debug_Statement field. Note that this field is considered syntactic - -- field, since it is created by the parser. - -- Default_Expression (Node5-Sem) -- This field is Empty if there is no default expression. If there is a -- simple default expression (one with no side effects), then this field @@ -2069,7 +2060,6 @@ package Sinfo is -- Sloc points to PRAGMA -- Next_Pragma (Node1-Sem) -- Pragma_Argument_Associations (List2) (set to No_List if none) - -- Debug_Statement (Node3) (set to Empty if not Debug) -- Pragma_Identifier (Node4) -- Next_Rep_Item (Node5-Sem) -- Pragma_Enabled (Flag5-Sem) @@ -8201,9 +8191,6 @@ package Sinfo is function Dcheck_Function (N : Node_Id) return Entity_Id; -- Node5 - function Debug_Statement - (N : Node_Id) return Node_Id; -- Node3 - function Declarations (N : Node_Id) return List_Id; -- List2 @@ -9173,9 +9160,6 @@ package Sinfo is procedure Set_Dcheck_Function (N : Node_Id; Val : Entity_Id); -- Node5 - procedure Set_Debug_Statement - (N : Node_Id; Val : Node_Id); -- Node3 - procedure Set_Declarations (N : Node_Id; Val : List_Id); -- List2 @@ -10105,7 +10089,7 @@ package Sinfo is N_Pragma => (1 => False, -- Next_Pragma (Node1-Sem) 2 => True, -- Pragma_Argument_Associations (List2) - 3 => True, -- Debug_Statement (Node3) + 3 => False, -- unused 4 => True, -- Pragma_Identifier (Node4) 5 => False), -- Next_Rep_Item (Node5-Sem) @@ -11732,7 +11716,6 @@ package Sinfo is pragma Inline (Corresponding_Spec); pragma Inline (Corresponding_Stub); pragma Inline (Dcheck_Function); - pragma Inline (Debug_Statement); pragma Inline (Declarations); pragma Inline (Default_Expression); pragma Inline (Default_Storage_Pool); @@ -12053,7 +12036,6 @@ package Sinfo is pragma Inline (Set_Corresponding_Spec); pragma Inline (Set_Corresponding_Stub); pragma Inline (Set_Dcheck_Function); - pragma Inline (Set_Debug_Statement); pragma Inline (Set_Declarations); pragma Inline (Set_Default_Expression); pragma Inline (Set_Default_Storage_Pool); diff --git a/gcc/ada/tbuild.adb b/gcc/ada/tbuild.adb index 91fbf85121a..be4ca8aceab 100644 --- a/gcc/ada/tbuild.adb +++ b/gcc/ada/tbuild.adb @@ -388,14 +388,12 @@ package body Tbuild is function Make_Pragma (Sloc : Source_Ptr; Chars : Name_Id; - Pragma_Argument_Associations : List_Id := No_List; - Debug_Statement : Node_Id := Empty) return Node_Id + Pragma_Argument_Associations : List_Id := No_List) return Node_Id is begin return Make_Pragma (Sloc, Pragma_Argument_Associations => Pragma_Argument_Associations, - Debug_Statement => Debug_Statement, Pragma_Identifier => Make_Identifier (Sloc, Chars)); end Make_Pragma; diff --git a/gcc/ada/tbuild.ads b/gcc/ada/tbuild.ads index 9ba04270592..0ece7bd5244 100644 --- a/gcc/ada/tbuild.ads +++ b/gcc/ada/tbuild.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2010, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2011, 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- -- @@ -150,8 +150,7 @@ package Tbuild is function Make_Pragma (Sloc : Source_Ptr; Chars : Name_Id; - Pragma_Argument_Associations : List_Id := No_List; - Debug_Statement : Node_Id := Empty) return Node_Id; + Pragma_Argument_Associations : List_Id := No_List) return Node_Id; -- A convenient form of Make_Pragma not requiring a Pragma_Identifier -- argument (this argument is built from the value given for Chars). -- 2.30.2