[Ada] local exception handling (cont'd)
Arnaud Charlet
charlet@adacore.com
Wed Apr 11 10:16:00 GMT 2007
Tested on i686-linux, committed on trunk
Continuation work to add support for local exception handling
(transformation of local raise statements into goto), and continuation
of work on Ada 2005 coextensions.
2007-04-06 Ed Schonberg <schonberg@adacore.com>
Robert Dewar <dewar@adacore.com>
* 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
-------------- next part --------------
Index: sinfo.ads
===================================================================
--- sinfo.ads (revision 123291)
+++ sinfo.ads (working copy)
@@ -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);
Index: sinfo.adb
===================================================================
--- sinfo.adb (revision 123291)
+++ sinfo.adb (working copy)
@@ -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
Index: sprint.ads
===================================================================
--- sprint.ads (revision 123291)
+++ sprint.ads (working copy)
@@ -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
Index: sprint.adb
===================================================================
--- sprint.adb (revision 123291)
+++ sprint.adb (working copy)
@@ -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");
More information about the Gcc-patches
mailing list