From: Ed Schonberg Date: Fri, 6 Apr 2007 09:27:42 +0000 (+0200) Subject: sinfo.ads, sinfo.adb (Coextensions): New element list for allocators... X-Git-Url: http://review.tizen.org/git/?a=commitdiff_plain;h=f28573f4914479bb9f9ca96f3a1436dcadb36c51;p=platform%2Fupstream%2Fgcc.git sinfo.ads, sinfo.adb (Coextensions): New element list for allocators... 2007-04-06 Ed Schonberg Robert Dewar * sinfo.ads, sinfo.adb (Coextensions): New element list for allocators, to chain nested components that are allocators for access discriminants of the enclosing object. Add N_Push and N_Pop nodes New field Exception_Label added (Local_Raise_Statements): New field in N_Exception_Handler_Node (Local_Raise_Not_OK): New flag in N_Exception_Handler_Node (Is_Coextension): New flag for allocators, to mark allocators that correspond to access discriminants of dynamically allocated objects. (N_Block_Statement): Document the fact that the corresponding entity can be an E_Return_Statement. (Is_Coextension): New flag for allocators. Remove all code for DSP option * sprint.ads, sprint.adb: Display basic information for class_wide subtypes. Add handling of N_Push and N_Pop nodes From-SVN: r123600 --- diff --git a/gcc/ada/sinfo.adb b/gcc/ada/sinfo.adb index c994631..6d0f289 100644 --- a/gcc/ada/sinfo.adb +++ b/gcc/ada/sinfo.adb @@ -380,6 +380,14 @@ package body Sinfo is return List1 (N); end Choices; + function Coextensions + (N : Node_Id) return Elist_Id is + begin + pragma Assert (False + or else NT (N).Nkind = N_Allocator); + return Elist4 (N); + end Coextensions; + function Comes_From_Extended_Return_Statement (N : Node_Id) return Boolean is begin @@ -1100,6 +1108,17 @@ package body Sinfo is return Flag7 (N); end Exception_Junk; + function Exception_Label + (N : Node_Id) return Node_Id is + begin + pragma Assert (False + or else NT (N).Nkind = N_Exception_Handler + or else NT (N).Nkind = N_Push_Constraint_Error_Label + or else NT (N).Nkind = N_Push_Program_Error_Label + or else NT (N).Nkind = N_Push_Storage_Error_Label); + return Node5 (N); + end Exception_Label; + function Expansion_Delayed (N : Node_Id) return Boolean is begin @@ -1522,6 +1541,14 @@ package body Sinfo is return Flag7 (N); end Is_Asynchronous_Call_Block; + function Is_Coextension + (N : Node_Id) return Boolean is + begin + pragma Assert (False + or else NT (N).Nkind = N_Allocator); + return Flag18 (N); + end Is_Coextension; + function Is_Component_Left_Opnd (N : Node_Id) return Boolean is begin @@ -1740,6 +1767,22 @@ package body Sinfo is return List1 (N); end Literals; + function Local_Raise_Not_OK + (N : Node_Id) return Boolean is + begin + pragma Assert (False + or else NT (N).Nkind = N_Exception_Handler); + return Flag7 (N); + end Local_Raise_Not_OK; + + function Local_Raise_Statements + (N : Node_Id) return Elist_Id is + begin + pragma Assert (False + or else NT (N).Nkind = N_Exception_Handler); + return Elist1 (N); + end Local_Raise_Statements; + function Loop_Actions (N : Node_Id) return List_Id is begin @@ -3022,6 +3065,14 @@ package body Sinfo is Set_List1_With_Parent (N, Val); end Set_Choices; + procedure Set_Coextensions + (N : Node_Id; Val : Elist_Id) is + begin + pragma Assert (False + or else NT (N).Nkind = N_Allocator); + Set_Elist4 (N, Val); + end Set_Coextensions; + procedure Set_Comes_From_Extended_Return_Statement (N : Node_Id; Val : Boolean := True) is begin @@ -3733,6 +3784,17 @@ package body Sinfo is Set_Flag7 (N, Val); end Set_Exception_Junk; + procedure Set_Exception_Label + (N : Node_Id; Val : Node_Id) is + begin + pragma Assert (False + or else NT (N).Nkind = N_Exception_Handler + or else NT (N).Nkind = N_Push_Constraint_Error_Label + or else NT (N).Nkind = N_Push_Program_Error_Label + or else NT (N).Nkind = N_Push_Storage_Error_Label); + Set_Node5 (N, Val); -- semantic field, no parent set + end Set_Exception_Label; + procedure Set_Expansion_Delayed (N : Node_Id; Val : Boolean := True) is begin @@ -4155,6 +4217,14 @@ package body Sinfo is Set_Flag7 (N, Val); end Set_Is_Asynchronous_Call_Block; + procedure Set_Is_Coextension + (N : Node_Id; Val : Boolean := True) is + begin + pragma Assert (False + or else NT (N).Nkind = N_Allocator); + Set_Flag18 (N, Val); + end Set_Is_Coextension; + procedure Set_Is_Component_Left_Opnd (N : Node_Id; Val : Boolean := True) is begin @@ -4373,6 +4443,22 @@ package body Sinfo is Set_List1_With_Parent (N, Val); end Set_Literals; + procedure Set_Local_Raise_Not_OK + (N : Node_Id; Val : Boolean := True) is + begin + pragma Assert (False + or else NT (N).Nkind = N_Exception_Handler); + Set_Flag7 (N, Val); + end Set_Local_Raise_Not_OK; + + procedure Set_Local_Raise_Statements + (N : Node_Id; Val : Elist_Id) is + begin + pragma Assert (False + or else NT (N).Nkind = N_Exception_Handler); + Set_Elist1 (N, Val); + end Set_Local_Raise_Statements; + procedure Set_Loop_Actions (N : Node_Id; Val : List_Id) is begin diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads index 13fe0fa..85fbcf1 100644 --- a/gcc/ada/sinfo.ads +++ b/gcc/ada/sinfo.ads @@ -462,6 +462,10 @@ package Sinfo is -- already been analyzed, both for efficiency and functional correctness -- reasons. + -- Coextensions (Elist4-Sem) + -- Present in allocators nodes. Points to list of allocators for the + -- access discriminants of the allocated object, + -- Comes_From_Source (Flag2) -- This flag is on for any nodes built by the scanner or parser from the -- source program, and off for any nodes built by the analyzer or @@ -474,6 +478,15 @@ package Sinfo is -- refers to a node or is posted on its source location, and has the -- effect of inhibiting further messages involving this same node. + -- Local_Raise_Statements (Elist1) + -- This field is present in exception handler nodes. It is set to + -- No_Elist in the normal case. If there is at least one raise statement + -- which can potentially be handled as a local raise, then this field + -- points to a list of raise nodes, which are calls to a routine to raise + -- an exception. These are raise nodes which can be optimized into gotos + -- if the handler turns out to meet the conditions which permit this + -- transformation. + -- Has_Dynamic_Length_Check (Flag10-Sem) -- This flag is present on all nodes. It is set to indicate that one of -- the routines in unit Checks has generated a length check action which @@ -532,7 +545,12 @@ package Sinfo is -- declared Activation_Chain variable when the first task is declared. -- When tasks are declared in the corresponding declarative region this -- entity is located by name (its name is always _Chain) and the declared - -- tasks are added to the chain. + -- tasks are added to the chain. Note that N_Extended_Return_Statement + -- does not have this attribute, although it does have an activation + -- chain. This chain is used to store the tasks temporarily, and is not + -- used for activating them. On successful completion of the return + -- statement, the tasks are moved to the caller's chain, and the caller + -- activates them. -- Acts_As_Spec (Flag4-Sem) -- A flag set in the N_Subprogram_Body node for a subprogram body which @@ -643,7 +661,7 @@ package Sinfo is -- freeze point. -- Comes_From_Extended_Return_Statement (Flag18-Sem) - -- Present in N_Return_Statement nodes. True if this node was + -- Present in N_Return_Statement nodes. True if this node was -- constructed as part of the expansion of an -- N_Extended_Return_Statement. @@ -702,7 +720,7 @@ package Sinfo is -- Corresponding_Generic_Association (Node5-Sem) -- This field is defined for object declarations and object renaming -- declarations. It is set for the declarations within an instance that - -- map generic formals to their actuals. If set, the field points to + -- map generic formals to their actuals. If set, the field points to -- a generic_association which is the original parent of the expression -- or name appearing in the declaration. This simplifies ASIS queries. @@ -939,6 +957,15 @@ package Sinfo is -- analyzing the control flow of the relevant sequence of statements -- (e.g. to check that it does not end with a bad return statement). + -- Exception_Label (Node5-Sem) + -- Appears in N_Push_xxx_Label nodes. Points to the entity of the label + -- to be used for transforming the corresponding exception into a goto, + -- or contains Empty, if this exception is not to be transformed. Also + -- appears in N_Exception_Handler nodes, where, if set, it indicates + -- that there may be a local raise for the handler, so that expansion + -- to allow a goto is required (and this field contains the label for + -- this goto). See Exp_Ch11.Expand_Local_Exception_Handlers for details. + -- Expansion_Delayed (Flag11-Sem) -- Set on aggregates and extension aggregates that need a top-down rather -- than bottom up expansion. Typically aggregate expansion happens bottom @@ -1116,6 +1143,12 @@ package Sinfo is -- expansion of an asynchronous entry call. Such a block needs cleanup -- handler to assure that the call is cancelled. + -- Is_Coextension (Flag18-Sem) + -- Present in allocator nodes, to indicate that this is an allocator + -- for an access discriminant of a dynamically allocated object. The + -- coextension must be deallocated and finalized at the same time as + -- the enclosing object. + -- Is_Component_Left_Opnd (Flag13-Sem) -- Is_Component_Right_Opnd (Flag14-Sem) -- Present in concatenation nodes, to indicate that the corresponding @@ -1214,6 +1247,8 @@ package Sinfo is -- N_Block_Statement or N_Loop_Statement node to which the label -- declaration applies. This is not currently used in the compiler -- itself, but it is useful in the implementation of ASIS queries. + -- This field is left empty for the special labels generated as part + -- of expanding raise statements with a local exception handler. -- Library_Unit (Node4-Sem) -- In a stub node, Library_Unit points to the compilation unit node of @@ -1259,6 +1294,12 @@ package Sinfo is -- package is mentioned in a limited_with_clause in the closure of the -- unit being compiled. + -- Local_Raise_Not_OK (Flag7-Sem) + -- Present in N_Exception_Handler nodes. Set if the handler contains + -- a construct (reraise statement, or call to subprogram in package + -- GNAT.Current_Exception) that makes the handler unsuitable as a target + -- for a local raise (one that could otherwise be converted to a goto). + -- Must_Be_Byte_Aligned (Flag14-Sem) -- This flag is present in N_Attribute_Reference nodes. It can be set -- only for the Address and Unrestricted_Access attributes. If set it @@ -1483,25 +1524,23 @@ package Sinfo is -- Static_Processing_OK (Flag4-Sem) -- Present in N_Aggregate nodes. When the Compile_Time_Known_Aggregate -- flag is set, the full value of the aggregate can be determined at - -- compile time and the aggregate can be passed as is to the back-end. In - -- this event it is irrelevant whether this flag is set or not. However, - -- if the Compile_Time_Known_Aggregate flag is not set but + -- compile time and the aggregate can be passed as is to the back-end. + -- In this event it is irrelevant whether this flag is set or not. + -- However, if the flag Compile_Time_Known_Aggregate is not set but -- Static_Processing_OK is set, the aggregate can (but need not) be -- converted into a compile time known aggregate by the expander. See -- Sem_Aggr for the specific conditions under which an aggregate has its -- Static_Processing_OK flag set. -- Storage_Pool (Node1-Sem) - -- Present in N_Allocator, N_Free_Statement, N_Return_Statement, - -- and N_Extended_Return_Statement nodes. - -- References the entity for the storage pool to be used for the allocate - -- or free call or for the allocation of the returned value from a - -- function. Empty indicates that the global default default pool is to - -- be used. Note that in the case of a return statement, this field is - -- set only if the function returns value of a type whose size is not - -- known at compile time on the secondary stack. It is never set on - -- targets for which the parameter Functions_Return_By_DSP_On_Target in - -- Targparm is True. + -- Present in N_Allocator, N_Free_Statement, N_Return_Statement, and + -- N_Extended_Return_Statement nodes. References the entity for the + -- storage pool to be used for the allocate or free call or for the + -- allocation of the returned value from function. Empty indicates that + -- the global default default pool is to be used. Note that in the case + -- of a return statement, this field is set only if the function returns + -- value of a type whose size is not known at compile time on the + -- secondary stack. -- Target_Type (Node2-Sem) -- Used in an N_Validate_Unchecked_Conversion node to point to the target @@ -3602,8 +3641,10 @@ package Sinfo is -- Null_Exclusion_Present (Flag11) -- Storage_Pool (Node1-Sem) -- Procedure_To_Call (Node2-Sem) + -- Coextensions (Elist4-Sem) -- No_Initialization (Flag13-Sem) -- Do_Storage_Check (Flag17-Sem) + -- Is_Coextension (Flag18-Sem) -- plus fields for expression --------------------------------- @@ -3868,19 +3909,21 @@ package Sinfo is -- Note that the occurrence of a block identifier is not a defining -- identifier, but rather a referencing occurrence. The defining - -- occurrence is in the implicit label declaration which occurs in - -- the innermost enclosing block. - - -- Note: there is always a block statement identifier present in - -- the tree, even if none was given in the source. In the case where - -- no block identifier is given in the source, the parser creates - -- a name of the form _Block_n, where n is a decimal integer (the - -- two underlines ensure that the block names created in this manner - -- do not conflict with any user defined identifiers), and the flag - -- Has_Created_Identifier is set to True. The only exception to the - -- rule that all loop statement nodes have identifiers occurs for - -- blocks constructed by the expander, and the semantic analyzer - -- creates and supplies dummy names for the blocks). + -- occurrence is an E_Block entity declared by the implicit label + -- declaration which occurs in the innermost enclosing block statement + -- or body; the block identifier denotes that E_Block. + + -- For block statements that come from source code, there is always a + -- block statement identifier present in the tree, denoting an + -- E_Block. In the case where no block identifier is given in the + -- source, the parser creates a name of the form B_n, where n is a + -- decimal integer, and the flag Has_Created_Identifier is set to + -- True. Blocks constructed by the expander usually have no identifier, + -- and no corresponding entity. + + -- Note well: the block statement created for an extended return + -- statement has an entity, and this entity is an E_Return_Statement, + -- rather than the usual E_Block. -- N_Block_Statement -- Sloc points to DECLARE or BEGIN @@ -5518,7 +5561,10 @@ package Sinfo is -- Choice_Parameter (Node2) (set to Empty if not present) -- Exception_Choices (List4) -- Statements (List3) + -- Exception_Label (Node5-Sem) (set to Empty of not present) -- Zero_Cost_Handling (Flag5-Sem) + -- Local_Raise_Statements (Elist1-Sem) (set to No_Elist if not present) + -- Local_Raise_Not_OK (Flag7-Sem) ------------------------------------------ -- 11.2 Choice parameter specification -- @@ -6483,7 +6529,10 @@ package Sinfo is -- error. The creation of this node will usually be accompanied by a -- message (unless it appears within the right operand of a short -- circuit form whose left argument is static and decisively - -- eliminates elaboration of the raise operation. + -- eliminates elaboration of the raise operation. The condition field + -- can ONLY be present when the node is used as a statement form, it + -- may NOT be present in the case where the node appears within an + -- expression. -- The exception is generated with a message that contains the -- file name and line number, and then appended text. The Reason @@ -6522,6 +6571,72 @@ package Sinfo is -- In the case where a debug source file is generated, the Sloc for -- this node points to the left bracket in the Sprint file output. + -- Note: the back end may be required to translate these nodes into + -- appropriate goto statements. See description of N_Push/Pop_xxx_Label. + + --------------------------------------------- + -- Optimization of Exception Raise to Goto -- + --------------------------------------------- + + -- In some cases, the front end will determine that any exception raised + -- by the back end for a certain exception should be transformed into a + -- goto statement. + + -- There are three kinds of exceptions raised by the back end (note that + -- for this purpose we consider gigi to be part of the back end in the + -- gcc case): + + -- 1. Exceptions resulting from N_Raise_xxx_Error nodes + -- 2. Exceptions from checks triggered by Do_xxx_Check flags + -- 3. Other cases not specifically marked by the front end + + -- Normally all such exceptions are translated into calls to the proper + -- Rcheck_xx procedure, where xx encodes both the exception to be raised + -- and the exception message. + + -- The front end may determine that for a particular sequence of code, + -- exceptions in any of these three categories for a particular builtin + -- exception should result in a goto, rather than a call to Rcheck_xx. + -- The exact sequence to be generated is: + + -- Local_Raise (exception'Identity); + -- goto Label + + -- The front end marks such a sequence of code by bracketing it with + -- push and pop nodes: + + -- N_Push_xxx_Label (referencing the label) + -- ... + -- (code where transformation is expected for exception xxx) + -- ... + -- N_Pop_xxx_Label + + -- The use of push/pop reflects the fact that such regions can properly + -- nest, and one special case is a subregion in which no transformation + -- is allowed. Such a region is marked by a N_Push_xxx_Label node whose + -- Exception_Label field is Empty. + + -- N_Push_Constraint_Error_Label + -- Sloc references first statement in region covered + -- Exception_Label (Node5-Sem) + + -- N_Push_Program_Error_Label + -- Sloc references first statement in region covered + -- Exception_Label (Node5-Sem) + + -- N_Push_Storage_Error_Label + -- Sloc references first statement in region covered + -- Exception_Label (Node5-Sem) + + -- N_Pop_Constraint_Error_Label + -- Sloc references last statement in region covered + + -- N_Pop_Program_Error_Label + -- Sloc references last statement in region covered + + -- N_Pop_Storage_Error_Label + -- Sloc references last statement in region covered + --------------- -- Reference -- --------------- @@ -6978,6 +7093,18 @@ package Sinfo is N_Formal_Abstract_Subprogram_Declaration, N_Formal_Concrete_Subprogram_Declaration, + -- N_Push_xxx_Label + + N_Push_Constraint_Error_Label, + N_Push_Program_Error_Label, + N_Push_Storage_Error_Label, + + -- N_Pop_xxx_Label + + N_Pop_Constraint_Error_Label, + N_Pop_Program_Error_Label, + N_Pop_Storage_Error_Label, + -- Other nodes (not part of any subtype class) N_Abortable_Part, @@ -7161,6 +7288,14 @@ package Sinfo is N_Package_Body .. N_Task_Body; + subtype N_Push_xxx_Label is Node_Kind range + N_Push_Constraint_Error_Label .. + N_Push_Storage_Error_Label; + + subtype N_Pop_xxx_Label is Node_Kind range + N_Pop_Constraint_Error_Label .. + N_Pop_Storage_Error_Label; + subtype N_Raise_xxx_Error is Node_Kind range N_Raise_Constraint_Error .. N_Raise_Storage_Error; @@ -7327,6 +7462,9 @@ package Sinfo is function Choices (N : Node_Id) return List_Id; -- List1 + function Coextensions + (N : Node_Id) return Elist_Id; -- Elist4 + function Comes_From_Extended_Return_Statement (N : Node_Id) return Boolean; -- Flag18 @@ -7549,6 +7687,9 @@ package Sinfo is function Exception_Junk (N : Node_Id) return Boolean; -- Flag7 + function Exception_Label + (N : Node_Id) return Node_Id; -- Node5 + function Explicit_Actual_Parameter (N : Node_Id) return Node_Id; -- Node3 @@ -7681,6 +7822,9 @@ package Sinfo is function Is_Asynchronous_Call_Block (N : Node_Id) return Boolean; -- Flag7 + function Is_Coextension + (N : Node_Id) return Boolean; -- Flag18 + function Is_Component_Left_Opnd (N : Node_Id) return Boolean; -- Flag13 @@ -7756,6 +7900,12 @@ package Sinfo is function Literals (N : Node_Id) return List_Id; -- List1 + function Local_Raise_Not_OK + (N : Node_Id) return Boolean; -- Flag7 + + function Local_Raise_Statements + (N : Node_Id) return Elist_Id; -- Elist1 + function Loop_Actions (N : Node_Id) return List_Id; -- List2 @@ -8158,6 +8308,9 @@ package Sinfo is procedure Set_Choice_Parameter (N : Node_Id; Val : Node_Id); -- Node2 + procedure Set_Coextensions + (N : Node_Id; Val : Elist_Id); -- Elist4 + procedure Set_Choices (N : Node_Id; Val : List_Id); -- List1 @@ -8380,6 +8533,9 @@ package Sinfo is procedure Set_Exception_Junk (N : Node_Id; Val : Boolean := True); -- Flag7 + procedure Set_Exception_Label + (N : Node_Id; Val : Node_Id); -- Node5 + procedure Set_Expansion_Delayed (N : Node_Id; Val : Boolean := True); -- Flag11 @@ -8512,6 +8668,9 @@ package Sinfo is procedure Set_Is_Asynchronous_Call_Block (N : Node_Id; Val : Boolean := True); -- Flag7 + procedure Set_Is_Coextension + (N : Node_Id; Val : Boolean := True); -- Flag18 + procedure Set_Is_Component_Left_Opnd (N : Node_Id; Val : Boolean := True); -- Flag13 @@ -8587,6 +8746,12 @@ package Sinfo is procedure Set_Literals (N : Node_Id; Val : List_Id); -- List1 + procedure Set_Local_Raise_Not_OK + (N : Node_Id; Val : Boolean := True); -- Flag7 + + procedure Set_Local_Raise_Statements + (N : Node_Id; Val : Elist_Id); -- Elist1 + procedure Set_Loop_Actions (N : Node_Id; Val : List_Id); -- List2 @@ -9463,7 +9628,7 @@ package Sinfo is (1 => False, -- Storage_Pool (Node1-Sem) 2 => False, -- Procedure_To_Call (Node2-Sem) 3 => True, -- Expression (Node3) - 4 => False, -- unused + 4 => False, -- Coextensions (Elist4-Sem) 5 => False), -- Etype (Node5-Sem) N_Null_Statement => @@ -10034,11 +10199,11 @@ package Sinfo is 5 => True), -- Exception_Handlers (List5) N_Exception_Handler => - (1 => False, -- unused + (1 => False, -- Local_Raise_Statements (Elist1) 2 => True, -- Choice_Parameter (Node2) 3 => True, -- Statements (List3) 4 => True, -- Exception_Choices (List4) - 5 => False), -- unused + 5 => False), -- Exception_Label (Node5) N_Raise_Statement => (1 => False, -- unused @@ -10334,6 +10499,48 @@ package Sinfo is 4 => False, -- unused 5 => False), -- Etype (Node5-Sem) + N_Push_Constraint_Error_Label => + (1 => False, -- unused + 2 => False, -- unused + 3 => False, -- unused + 4 => False, -- unused + 5 => False), -- unused + + N_Push_Program_Error_Label => + (1 => False, -- Exception_Label + 2 => False, -- unused + 3 => False, -- unused + 4 => False, -- unused + 5 => False), -- Exception_Label + + N_Push_Storage_Error_Label => + (1 => False, -- Exception_Label + 2 => False, -- unused + 3 => False, -- unused + 4 => False, -- unused + 5 => False), -- Exception_Label + + N_Pop_Constraint_Error_Label => + (1 => False, -- unused + 2 => False, -- unused + 3 => False, -- unused + 4 => False, -- unused + 5 => False), -- unused + + N_Pop_Program_Error_Label => + (1 => False, -- unused + 2 => False, -- unused + 3 => False, -- unused + 4 => False, -- unused + 5 => False), -- unused + + N_Pop_Storage_Error_Label => + (1 => False, -- unused + 2 => False, -- unused + 3 => False, -- unused + 4 => False, -- unused + 5 => False), -- unused + N_Reference => (1 => False, -- unused 2 => False, -- unused @@ -10443,6 +10650,7 @@ package Sinfo is pragma Inline (Check_Address_Alignment); pragma Inline (Choice_Parameter); pragma Inline (Choices); + pragma Inline (Coextensions); pragma Inline (Comes_From_Extended_Return_Statement); pragma Inline (Compile_Time_Known_Aggregate); pragma Inline (Component_Associations); @@ -10515,8 +10723,9 @@ package Sinfo is pragma Inline (Entry_Index_Specification); pragma Inline (Etype); pragma Inline (Exception_Choices); - pragma Inline (Exception_Junk); pragma Inline (Exception_Handlers); + pragma Inline (Exception_Junk); + pragma Inline (Exception_Label); pragma Inline (Expansion_Delayed); pragma Inline (Explicit_Actual_Parameter); pragma Inline (Explicit_Generic_Actual_Parameter); @@ -10542,6 +10751,7 @@ package Sinfo is pragma Inline (Has_Created_Identifier); pragma Inline (Has_Dynamic_Length_Check); pragma Inline (Has_Dynamic_Range_Check); + pragma Inline (Has_Self_Reference); pragma Inline (Has_No_Elaboration_Code); pragma Inline (Has_Priority_Pragma); pragma Inline (Has_Private_View); @@ -10560,6 +10770,7 @@ package Sinfo is pragma Inline (Instance_Spec); pragma Inline (Intval); pragma Inline (Is_Asynchronous_Call_Block); + pragma Inline (Is_Coextension); pragma Inline (Is_Component_Left_Opnd); pragma Inline (Is_Component_Right_Opnd); pragma Inline (Is_Controlling_Actual); @@ -10570,7 +10781,6 @@ package Sinfo is pragma Inline (Is_Overloaded); pragma Inline (Is_Power_Of_2_For_Shift); pragma Inline (Is_Protected_Subprogram_Body); - pragma Inline (Has_Self_Reference); pragma Inline (Is_Static_Expression); pragma Inline (Is_Subprogram_Descriptor); pragma Inline (Is_Task_Allocation_Block); @@ -10586,6 +10796,8 @@ package Sinfo is pragma Inline (Limited_View_Installed); pragma Inline (Limited_Present); pragma Inline (Literals); + pragma Inline (Local_Raise_Not_OK); + pragma Inline (Local_Raise_Statements); pragma Inline (Loop_Actions); pragma Inline (Loop_Parameter_Specification); pragma Inline (Low_Bound); @@ -10718,6 +10930,7 @@ package Sinfo is pragma Inline (Set_Check_Address_Alignment); pragma Inline (Set_Choice_Parameter); pragma Inline (Set_Choices); + pragma Inline (Set_Coextensions); pragma Inline (Set_Comes_From_Extended_Return_Statement); pragma Inline (Set_Compile_Time_Known_Aggregate); pragma Inline (Set_Component_Associations); @@ -10789,8 +11002,9 @@ package Sinfo is pragma Inline (Set_Entry_Index_Specification); pragma Inline (Set_Etype); pragma Inline (Set_Exception_Choices); - pragma Inline (Set_Exception_Junk); pragma Inline (Set_Exception_Handlers); + pragma Inline (Set_Exception_Junk); + pragma Inline (Set_Exception_Label); pragma Inline (Set_Expansion_Delayed); pragma Inline (Set_Explicit_Actual_Parameter); pragma Inline (Set_Explicit_Generic_Actual_Parameter); @@ -10834,6 +11048,7 @@ package Sinfo is pragma Inline (Set_Instance_Spec); pragma Inline (Set_Intval); pragma Inline (Set_Is_Asynchronous_Call_Block); + pragma Inline (Set_Is_Coextension); pragma Inline (Set_Is_Component_Left_Opnd); pragma Inline (Set_Is_Component_Right_Opnd); pragma Inline (Set_Is_Controlling_Actual); @@ -10860,6 +11075,8 @@ package Sinfo is pragma Inline (Set_Limited_View_Installed); pragma Inline (Set_Limited_Present); pragma Inline (Set_Literals); + pragma Inline (Set_Local_Raise_Not_OK); + pragma Inline (Set_Local_Raise_Statements); pragma Inline (Set_Loop_Actions); pragma Inline (Set_Loop_Parameter_Specification); pragma Inline (Set_Low_Bound); diff --git a/gcc/ada/sprint.adb b/gcc/ada/sprint.adb index 2343aec..51131e3 100644 --- a/gcc/ada/sprint.adb +++ b/gcc/ada/sprint.adb @@ -2218,6 +2218,42 @@ package body Sprint is Write_Str (", "); end if; + when N_Pop_Constraint_Error_Label => + Write_Indent_Str ("%pop_constraint_error_label"); + + when N_Pop_Program_Error_Label => + Write_Indent_Str ("%pop_program_error_label"); + + when N_Pop_Storage_Error_Label => + Write_Indent_Str ("%pop_storage_error_label"); + + when N_Push_Constraint_Error_Label => + Write_Indent_Str ("%push_constraint_error_label ("); + + if Present (Exception_Label (Node)) then + Write_Name_With_Col_Check (Chars (Exception_Label (Node))); + end if; + + Write_Str (")"); + + when N_Push_Program_Error_Label => + Write_Indent_Str ("%push_program_error_label ("); + + if Present (Exception_Label (Node)) then + Write_Name_With_Col_Check (Chars (Exception_Label (Node))); + end if; + + Write_Str (")"); + + when N_Push_Storage_Error_Label => + Write_Indent_Str ("%push_storage_error_label ("); + + if Present (Exception_Label (Node)) then + Write_Name_With_Col_Check (Chars (Exception_Label (Node))); + end if; + + Write_Str (")"); + when N_Pragma => Write_Indent_Str_Sloc ("pragma "); Write_Name_With_Col_Check (Chars (Node)); @@ -3698,7 +3734,8 @@ package body Sprint is -- Class-Wide types - when E_Class_Wide_Type => + when E_Class_Wide_Type | + E_Class_Wide_Subtype => Write_Header; Write_Name_With_Col_Check (Chars (Etype (Typ))); Write_Str ("'Class"); diff --git a/gcc/ada/sprint.ads b/gcc/ada/sprint.ads index 0e869f0..66aeea8 100644 --- a/gcc/ada/sprint.ads +++ b/gcc/ada/sprint.ads @@ -67,6 +67,8 @@ package Sprint is -- Multiply wi Treat_Fixed_As_Integer x #* y -- Multiply wi Rounded_Result x @* y -- Others choice for cleanup when all others + -- Pop exception label %pop_xxx_exception_label + -- Push exception label %push_xxx_exception_label (label) -- Raise xxx error [xxx_error [when cond]] -- Raise xxx error with msg [xxx_error [when cond], "msg"] -- Rational literal See UR_Write for details