+2010-06-17 Robert Dewar <dewar@adacore.com>
+
+ * exp_ch4.ads: Minor code reorganization (specs in alpha order).
+
+2010-06-17 Robert Dewar <dewar@adacore.com>
+
+ * debug.adb: New debug flag -gnatd.X to use Expression_With_Actions
+ node when expanding short circuit form with actions present for right
+ opnd.
+ * exp_ch4.adb: Minor reformatting
+ (Expand_Short_Circuit_Operator): Use new Expression_With_Actions node if
+ right opeand has actions present, and debug flag -gnatd.X is set.
+ * exp_util.adb (Insert_Actions): Handle case of Expression_With_Actions
+ node.
+ * nlists.adb (Prepend_List): New procedure
+ (Prepend_List_To): New procedure
+ * nlists.ads (Prepend_List): New procedure
+ (Prepend_List_To): New procedure
+ * sem.adb: Add processing for Expression_With_Actions
+ * sem_ch4.adb (Analyze_Expression_With_Actions): New procedure
+ * sem_ch4.ads (Analyze_Expression_With_Actions): New procedure
+ * sem_res.adb: Add processing for Expression_With_Actions.
+ * sem_scil.adb: Add processing for Expression_With_Actions
+ * sinfo.ads, sinfo.adb (N_Expression_With_Actions): New node.
+ * sprint.ads, sprint.adb: Add processing for Expression_With_Actions
+
+2010-06-17 Doug Rupp <rupp@adacore.com>
+
+ * sem_intr.adb (Check_Intrinsic_Operator): Check that the types
+ involved both have underlying integer types.
+ * exp_intr.adb (Expand_Binary_Operator) New subprogram to expand a call
+ to an intrinsic operator when the operand types or sizes are not
+ identical.
+ * s-auxdec-vms_64.ads: Revert "+" "-" ops back to Address now that
+ 64/32 Address/Integer works.
+
2010-06-17 Ed Schonberg <schonberg@adacore.com>
* sem_ch12.adb (Mark_Context): Refine placement of Withed_Body flag, so
-- d.U
-- d.V
-- d.W Print out debugging information for Walk_Library_Items
- -- d.X
+ -- d.X Use Expression_With_Actions for short-circuited forms
-- d.Y
-- d.Z
-- the order in which units are walked. This is primarily for SofCheck
-- Inspector.
+ -- d.X By default, the compiler uses an elaborate rewriting framework for
+ -- short-circuited forms where the right hand condition generates
+ -- actions to be inserted. Use of this switch causes the compiler to
+ -- use the much simpler Expression_With_Actions node for this purpose.
+ -- It is a debug flag to aid transitional implementation in gigi and
+ -- the back end. As soon as that works fine, we will remove this flag.
+
-- d1 Error messages have node numbers where possible. Normally error
-- messages have only source locations. This option is useful when
-- debugging errors caused by expanded code, where the source location
if Nkind (Op1) = N_Op_Not then
if Kind = N_Op_And then
Proc_Name := RTE (RE_Vector_Nor);
-
elsif Kind = N_Op_Or then
Proc_Name := RTE (RE_Vector_Nand);
-
else
Proc_Name := RTE (RE_Vector_Xor);
end if;
else
if Kind = N_Op_And then
Proc_Name := RTE (RE_Vector_And);
-
elsif Kind = N_Op_Or then
Proc_Name := RTE (RE_Vector_Or);
-
elsif Nkind (Op2) = N_Op_Not then
Proc_Name := RTE (RE_Vector_Nxor);
Arg2 := Right_Opnd (Op2);
-
else
Proc_Name := RTE (RE_Vector_Xor);
end if;
Name => New_Occurrence_Of (Proc_Name, Loc),
Parameter_Associations => New_List (
Target,
- Make_Attribute_Reference (Loc,
- Prefix => Arg1,
- Attribute_Name => Name_Address),
- Make_Attribute_Reference (Loc,
- Prefix => Arg2,
- Attribute_Name => Name_Address),
- Make_Attribute_Reference (Loc,
- Prefix => Op1,
- Attribute_Name => Name_Length)));
+ Make_Attribute_Reference (Loc,
+ Prefix => Arg1,
+ Attribute_Name => Name_Address),
+ Make_Attribute_Reference (Loc,
+ Prefix => Arg2,
+ Attribute_Name => Name_Address),
+ Make_Attribute_Reference (Loc,
+ Prefix => Op1,
+ Attribute_Name => Name_Length)));
end if;
Rewrite (N, Call_Node);
-- Expand_Short_Circuit_Operator --
-----------------------------------
- -- Expand into conditional expression if Actions present, and also deal
- -- with optimizing case of arguments being True or False.
+ -- Deal with special expansion if actions are present for the right operand
+ -- and deal with optimizing case of arguments being True or False. We also
+ -- deal with the special case of non-standard boolean values.
procedure Expand_Short_Circuit_Operator (N : Node_Id) is
Loc : constant Source_Ptr := Sloc (N);
Kind : constant Node_Kind := Nkind (N);
Left : constant Node_Id := Left_Opnd (N);
Right : constant Node_Id := Right_Opnd (N);
+ LocR : constant Source_Ptr := Sloc (Right);
Actlist : List_Id;
Shortcut_Value : constant Boolean := Nkind (N) = N_Or_Else;
return;
end if;
- -- If Actions are present, we expand
+ -- If Actions are present for the right operand, we have to do some
+ -- special processing. We can't just let these actions filter back into
+ -- code preceding the short circuit (which is what would have happened
+ -- if we had not trapped them in the short-circuit form), since they
+ -- must only be executed if the right operand of the short circuit is
+ -- executed and not otherwise.
- -- left AND THEN right
+ -- the temporary variable C.
- -- into
+ if Present (Actions (N)) then
+ Actlist := Actions (N);
- -- C : Boolean := False;
- -- IF left THEN
- -- Actions;
- -- IF right THEN
- -- C := True;
- -- END IF;
- -- END IF;
+ -- The old approach is to expand:
- -- and finally rewrite the operator into a reference to C. Similarly
- -- for left OR ELSE right, with negated values. Note that this rewriting
- -- preserves two invariants that traces-based coverage analysis depends
- -- upon:
+ -- left AND THEN right
- -- - there is exactly one conditional jump for each operand;
+ -- into
- -- - for each possible values of the expression, there is exactly
- -- one location in the generated code that is branched to
- -- (the inner assignment in one case, the point just past the
- -- outer END IF; in the other case).
+ -- C : Boolean := False;
+ -- IF left THEN
+ -- Actions;
+ -- IF right THEN
+ -- C := True;
+ -- END IF;
+ -- END IF;
- if Present (Actions (N)) then
- Actlist := Actions (N);
+ -- and finally rewrite the operator into a reference to C. Similarly
+ -- for left OR ELSE right, with negated values. Note that this
+ -- rewrite causes some difficulties for coverage analysis because
+ -- of the introduction of the new variable C, which obscures the
+ -- structure of the test.
- Op_Var := Make_Temporary (Loc, 'C', Related_Node => N);
+ -- We use this "old approach" by default for now, unless the
+ -- special debug switch gnatd.X is used.
- Insert_Action (N,
- Make_Object_Declaration (Loc,
- Defining_Identifier =>
- Op_Var,
- Object_Definition =>
- New_Occurrence_Of (Standard_Boolean, Loc),
- Expression =>
- New_Occurrence_Of (Shortcut_Ent, Loc)));
-
- Append_To (Actlist,
- Make_Implicit_If_Statement (Right,
- Condition => Make_Test_Expr (Right),
- Then_Statements => New_List (
- Make_Assignment_Statement (Sloc (Right),
- Name =>
- New_Occurrence_Of (Op_Var, Sloc (Right)),
- Expression =>
- New_Occurrence_Of
- (Boolean_Literals (not Shortcut_Value), Sloc (Right))))));
+ if not Debug_Flag_Dot_XX then
+ Op_Var := Make_Temporary (Loc, 'C', Related_Node => N);
- Insert_Action (N,
- Make_Implicit_If_Statement (Left,
- Condition => Make_Test_Expr (Left),
- Then_Statements => Actlist));
+ Insert_Action (N,
+ Make_Object_Declaration (Loc,
+ Defining_Identifier =>
+ Op_Var,
+ Object_Definition =>
+ New_Occurrence_Of (Standard_Boolean, Loc),
+ Expression =>
+ New_Occurrence_Of (Shortcut_Ent, Loc)));
+
+ Append_To (Actlist,
+ Make_Implicit_If_Statement (Right,
+ Condition => Make_Test_Expr (Right),
+ Then_Statements => New_List (
+ Make_Assignment_Statement (LocR,
+ Name => New_Occurrence_Of (Op_Var, LocR),
+ Expression =>
+ New_Occurrence_Of
+ (Boolean_Literals (not Shortcut_Value), LocR)))));
- Rewrite (N, New_Occurrence_Of (Op_Var, Loc));
+ Insert_Action (N,
+ Make_Implicit_If_Statement (Left,
+ Condition => Make_Test_Expr (Left),
+ Then_Statements => Actlist));
+
+ Rewrite (N, New_Occurrence_Of (Op_Var, Loc));
+ Analyze_And_Resolve (N, Standard_Boolean);
+
+ -- The new approach, activated for now by the use of debug flag
+ -- -gnatd.X is to use the new Expression_With_Actions node for the
+ -- right operand of the short-circuit form. This should solve the
+ -- traceability problems for coverage analysis.
+
+ else
+ Rewrite (Right,
+ Make_Expression_With_Actions (LocR,
+ Expression => Relocate_Node (Right),
+ Actions => Actlist));
+ Analyze_And_Resolve (Right, Standard_Boolean);
+ end if;
+
+ -- Special processing necessary for SCIL generation for AND THEN
+ -- with a function call as the right operand.
+
+ -- What is this about, and is it needed for both cases above???
if Generate_SCIL
and then Kind = N_And_Then
Adjust_SCIL_Node (N, Right);
end if;
- Analyze_And_Resolve (N, Standard_Boolean);
Adjust_Result_Type (N, Typ);
return;
end if;
procedure Expand_N_Allocator (N : Node_Id);
procedure Expand_N_And_Then (N : Node_Id);
procedure Expand_N_Conditional_Expression (N : Node_Id);
- procedure Expand_N_In (N : Node_Id);
procedure Expand_N_Explicit_Dereference (N : Node_Id);
+ procedure Expand_N_In (N : Node_Id);
procedure Expand_N_Indexed_Component (N : Node_Id);
procedure Expand_N_Not_In (N : Node_Id);
procedure Expand_N_Null (N : Node_Id);
-- Local Subprograms --
-----------------------
+ procedure Expand_Binary_Operator_Call (N : Node_Id);
+ -- Expand a call to an intrinsic arithmetic operator when the operand
+ -- types or sizes are not identical.
+
procedure Expand_Is_Negative (N : Node_Id);
-- Expand a call to the intrinsic Is_Negative function
-- Name_Source_Location - expand string of form file:line
-- Name_Enclosing_Entity - expand string with name of enclosing entity
+ ---------------------------------
+ -- Expand_Binary_Operator_Call --
+ ---------------------------------
+
+ procedure Expand_Binary_Operator_Call (N : Node_Id) is
+ T1 : constant Entity_Id := Underlying_Type (Left_Opnd (N));
+ T2 : constant Entity_Id := Underlying_Type (Right_Opnd (N));
+ TR : constant Entity_Id := Etype (N);
+ T3 : Entity_Id;
+ Res : Node_Id;
+ Siz : Uint;
+
+ begin
+ if Esize (T1) > Esize (T2) then
+ Siz := Esize (T1);
+ else
+ Siz := Esize (T2);
+ end if;
+
+ if Siz > 32 then
+ T3 := RTE (RE_Unsigned_64);
+ else
+ T3 := RTE (RE_Unsigned_32);
+ end if;
+
+ Res := New_Copy (N);
+ Set_Etype (Res, Empty);
+ Set_Entity (Res, Empty);
+
+ Set_Left_Opnd (Res,
+ Unchecked_Convert_To (T3, Relocate_Node (Left_Opnd (N))));
+ Set_Right_Opnd (Res,
+ Unchecked_Convert_To (T3, Relocate_Node (Right_Opnd (N))));
+
+ Rewrite (N, Unchecked_Convert_To (TR, Res));
+ Analyze_And_Resolve (N, TR);
+ end Expand_Binary_Operator_Call;
+
-----------------------------------------
-- Expand_Dispatching_Constructor_Call --
-----------------------------------------
elsif Present (Alias (E)) then
Expand_Intrinsic_Call (N, Alias (E));
+ elsif Nkind (N) in N_Binary_Op then
+ Expand_Binary_Operator_Call (N);
+
-- The only other case is where an external name was specified,
-- since this is the only way that an otherwise unrecognized
-- name could escape the checking in Sem_Prag. Nothing needs
end if;
end;
+ -- Case of appearing within an Expressions_With_Actions node. We
+ -- prepend the actions to the list of actions already there.
+
+ when N_Expression_With_Actions =>
+ Prepend_List (Ins_Actions, Actions (P));
+ return;
+
-- Case of appearing in the condition of a while expression or
-- elsif. We insert the actions into the Condition_Actions field.
-- They will be moved further out when the while loop or elsif
Set_List_Link (Node, To);
end Prepend;
+ ------------------
+ -- Prepend_List --
+ ------------------
+
+ procedure Prepend_List (List : List_Id; To : List_Id) is
+
+ procedure Prepend_List_Debug;
+ pragma Inline (Prepend_List_Debug);
+ -- Output debug information if Debug_Flag_N set
+
+ ------------------------
+ -- Prepend_List_Debug --
+ ------------------------
+
+ procedure Prepend_List_Debug is
+ begin
+ if Debug_Flag_N then
+ Write_Str ("Prepend list ");
+ Write_Int (Int (List));
+ Write_Str (" to list ");
+ Write_Int (Int (To));
+ Write_Eol;
+ end if;
+ end Prepend_List_Debug;
+
+ -- Start of processing for Prepend_List
+
+ begin
+ if Is_Empty_List (List) then
+ return;
+
+ else
+ declare
+ F : constant Node_Id := First (To);
+ L : constant Node_Id := Last (List);
+ N : Node_Id;
+
+ begin
+ pragma Debug (Prepend_List_Debug);
+
+ N := L;
+ loop
+ Set_List_Link (N, To);
+ N := Prev (N);
+ exit when No (N);
+ end loop;
+
+ if No (F) then
+ Set_Last (To, L);
+ else
+ Set_Next (L, F);
+ end if;
+
+ Set_Prev (F, L);
+ Set_First (To, First (List));
+
+ Set_First (List, Empty);
+ Set_Last (List, Empty);
+ end;
+ end if;
+ end Prepend_List;
+
+ ---------------------
+ -- Prepend_List_To --
+ ---------------------
+
+ procedure Prepend_List_To (To : List_Id; List : List_Id) is
+ begin
+ Prepend_List (List, To);
+ end Prepend_List_To;
+
----------------
-- Prepend_To --
----------------
pragma Inline (Prepend_To);
-- Like Prepend, but arguments are the other way round
+ procedure Prepend_List (List : List_Id; To : List_Id);
+ -- Prepends node list List to the start of node list To. On return,
+ -- List is reset to be empty.
+
+ procedure Prepend_List_To (To : List_Id; List : List_Id);
+ pragma Inline (Prepend_List_To);
+ -- Like Prepend_List, but arguments are the other way round
+
procedure Remove (Node : Node_Id);
-- Removes Node, which must be a node that is a member of a node list,
-- from this node list. The contents of Node are not otherwise affected.
Address_Size : constant := Standard'Address_Size;
Short_Address_Size : constant := 32;
- function "+" (Left : Short_Address; Right : Integer) return Short_Address;
- function "+" (Left : Integer; Right : Short_Address) return Short_Address;
- function "-" (Left : Short_Address; Right : Short_Address) return Integer;
- function "-" (Left : Short_Address; Right : Integer) return Short_Address;
+ function "+" (Left : Address; Right : Integer) return Address;
+ function "+" (Left : Integer; Right : Address) return Address;
+ function "-" (Left : Address; Right : Address) return Integer;
+ function "-" (Left : Address; Right : Integer) return Address;
pragma Import (Intrinsic, "+");
pragma Import (Intrinsic, "-");
when N_Explicit_Dereference =>
Analyze_Explicit_Dereference (N);
+ when N_Expression_With_Actions =>
+ Analyze_Expression_With_Actions (N);
+
when N_Extended_Return_Statement =>
Analyze_Extended_Return_Statement (N);
if Nkind (Unit (Withed_Unit)) = N_Package_Body
and then Is_Generic_Instance
- (Defining_Entity (Unit (Library_Unit (Withed_Unit))))
+ (Defining_Entity (Unit (Library_Unit (Withed_Unit))))
then
Do_Withed_Unit (Library_Unit (Withed_Unit));
end if;
Check_Parameterless_Call (N);
end Analyze_Expression;
+ -------------------------------------
+ -- Analyze_Expression_With_Actions --
+ -------------------------------------
+
+ procedure Analyze_Expression_With_Actions (N : Node_Id) is
+ A : Node_Id;
+
+ begin
+ A := First (Actions (N));
+ loop
+ Analyze (A);
+ Next (A);
+ exit when No (A);
+ end loop;
+
+ Analyze_Expression (Expression (N));
+ Set_Etype (N, Etype (Expression (N)));
+ end Analyze_Expression_With_Actions;
+
------------------------------------
-- Analyze_Indexed_Component_Form --
------------------------------------
First_Actual : Node_Id;
begin
- -- Place the name of the operation, with its interpretations, on the
- -- rewritten call.
+ -- Place the name of the operation, with its interpretations,
+ -- on the rewritten call.
Set_Name (Call_Node, Subprog);
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2007, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2009, 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- --
procedure Analyze_Conditional_Expression (N : Node_Id);
procedure Analyze_Equality_Op (N : Node_Id);
procedure Analyze_Explicit_Dereference (N : Node_Id);
+ procedure Analyze_Expression_With_Actions (N : Node_Id);
procedure Analyze_Logical_Op (N : Node_Id);
procedure Analyze_Membership_Op (N : Node_Id);
procedure Analyze_Negation (N : Node_Id);
procedure Check_Intrinsic_Operator (E : Entity_Id; N : Node_Id);
-- Check that operator is one of the binary arithmetic operators, and
- -- that the types involved have the same size.
+ -- that the types involved both have underlying integer types..
procedure Check_Shift (E : Entity_Id; N : Node_Id);
-- Check intrinsic shift subprogram, the two arguments are the same
T2 := Etype (Next_Formal (First_Formal (E)));
end if;
- if Root_Type (T1) /= Root_Type (T2)
- or else Root_Type (T1) /= Root_Type (Ret)
+ if Root_Type (T1) = Root_Type (T2)
+ or else Root_Type (T1) = Root_Type (Ret)
+ then
+ -- Same types, predefined operator will apply
+
+ null;
+
+ elsif Is_Integer_Type (Underlying_Type (T1))
+ and then Is_Integer_Type (Underlying_Type (T2))
+ and then Is_Integer_Type (Underlying_Type (Ret))
then
+ -- Expansion will introduce conversions if sizes are not equal
+
+ null;
+
+ else
Errint
- ("types of intrinsic operator must have the same size", E, N);
+ ("types of intrinsic operator operands do not match", E, N);
end if;
-- Comparison operators
procedure Resolve_Character_Literal (N : Node_Id; Typ : Entity_Id);
procedure Resolve_Comparison_Op (N : Node_Id; Typ : Entity_Id);
procedure Resolve_Conditional_Expression (N : Node_Id; Typ : Entity_Id);
+ procedure Resolve_Entity_Name (N : Node_Id; Typ : Entity_Id);
procedure Resolve_Equality_Op (N : Node_Id; Typ : Entity_Id);
procedure Resolve_Explicit_Dereference (N : Node_Id; Typ : Entity_Id);
- procedure Resolve_Entity_Name (N : Node_Id; Typ : Entity_Id);
+ procedure Resolve_Expression_With_Actions (N : Node_Id; Typ : Entity_Id);
procedure Resolve_Indexed_Component (N : Node_Id; Typ : Entity_Id);
procedure Resolve_Integer_Literal (N : Node_Id; Typ : Entity_Id);
procedure Resolve_Logical_Op (N : Node_Id; Typ : Entity_Id);
-- Check that Typ is a remote access-to-subprogram type
if Is_Remote_Access_To_Subprogram_Type (Typ) then
+
-- Prefix (N) must statically denote a remote subprogram
-- declared in a package specification.
when N_Expanded_Name
=> Resolve_Entity_Name (N, Ctx_Type);
- when N_Extension_Aggregate
- => Resolve_Extension_Aggregate (N, Ctx_Type);
-
when N_Explicit_Dereference
=> Resolve_Explicit_Dereference (N, Ctx_Type);
+ when N_Expression_With_Actions
+ => Resolve_Expression_With_Actions (N, Ctx_Type);
+
+ when N_Extension_Aggregate
+ => Resolve_Extension_Aggregate (N, Ctx_Type);
+
when N_Function_Call
=> Resolve_Call (N, Ctx_Type);
end Resolve_Explicit_Dereference;
+ -------------------------------------
+ -- Resolve_Expression_With_Actions --
+ -------------------------------------
+
+ procedure Resolve_Expression_With_Actions (N : Node_Id; Typ : Entity_Id) is
+ begin
+ Set_Etype (N, Typ);
+ end Resolve_Expression_With_Actions;
+
-------------------------------
-- Resolve_Indexed_Component --
-------------------------------
N_Exception_Handler |
N_Expanded_Name |
N_Explicit_Dereference |
+ N_Expression_With_Actions |
N_Extension_Aggregate |
N_Floating_Point_Definition |
N_Formal_Decimal_Fixed_Point_Definition |
pragma Assert (False
or else NT (N).Nkind = N_And_Then
or else NT (N).Nkind = N_Compilation_Unit_Aux
+ or else NT (N).Nkind = N_Expression_With_Actions
or else NT (N).Nkind = N_Freeze_Entity
or else NT (N).Nkind = N_Or_Else);
return List1 (N);
or else NT (N).Nkind = N_Discriminant_Association
or else NT (N).Nkind = N_Discriminant_Specification
or else NT (N).Nkind = N_Exception_Declaration
+ or else NT (N).Nkind = N_Expression_With_Actions
or else NT (N).Nkind = N_Free_Statement
or else NT (N).Nkind = N_Mod_Clause
or else NT (N).Nkind = N_Modular_Type_Definition
pragma Assert (False
or else NT (N).Nkind = N_And_Then
or else NT (N).Nkind = N_Compilation_Unit_Aux
+ or else NT (N).Nkind = N_Expression_With_Actions
or else NT (N).Nkind = N_Freeze_Entity
or else NT (N).Nkind = N_Or_Else);
Set_List1_With_Parent (N, Val);
or else NT (N).Nkind = N_Discriminant_Association
or else NT (N).Nkind = N_Discriminant_Specification
or else NT (N).Nkind = N_Exception_Declaration
+ or else NT (N).Nkind = N_Expression_With_Actions
or else NT (N).Nkind = N_Free_Statement
or else NT (N).Nkind = N_Mod_Clause
or else NT (N).Nkind = N_Modular_Type_Definition
-- Has_Private_View (Flag11-Sem) set in generic units.
-- plus fields for expression
+ -----------------------------
+ -- Expression with Actions --
+ -----------------------------
+
+ -- This node is created by the analyzer/expander to handle some
+ -- expansion cases, notably short circuit forms where there are
+ -- actions associated with the right hand operand.
+
+ -- The N_Expression_With_Actions node represents an expression with
+ -- an associated set of actions (which are executable statements).
+ -- The required semantics is that the set of actions is executed in
+ -- the order in which it appears just before the expression is
+ -- evaluated (and these actions must only be executed if the value
+ -- of the expression is evaluated). The node is considered to be
+ -- a subexpression, whose value is the value of the Expression after
+ -- executing all the actions.
+
+ -- Sprint syntax: do
+ -- action;
+ -- action;
+ -- ...
+ -- action;
+ -- in expression end
+
+ -- N_Expression_With_Actions
+ -- Actions (List1)
+ -- Expression (Node3)
+ -- plus fields for expression
+
+ -- Note: the actions list is always non-null, since we would
+ -- never have created this node if there weren't some actions.
+
--------------------
-- Free Statement --
--------------------
N_Conditional_Expression,
N_Explicit_Dereference,
+ N_Expression_With_Actions,
N_Function_Call,
N_Indexed_Component,
N_Integer_Literal,
4 => False, -- Entity (Node4-Sem)
5 => False), -- Etype (Node5-Sem)
+ N_Expression_With_Actions =>
+ (1 => True, -- Actions (List1)
+ 2 => False, -- unused
+ 3 => True, -- Expression (Node3)
+ 4 => False, -- unused
+ 5 => False), -- unused
+
N_Free_Statement =>
(1 => False, -- Storage_Pool (Node1-Sem)
2 => False, -- Procedure_To_Call (Node2-Sem)
Write_Char_Sloc ('.');
Write_Str_Sloc ("all");
+ when N_Expression_With_Actions =>
+ Indent_Begin;
+ Write_Indent_Str_Sloc ("do");
+ Indent_Begin;
+ Write_Indent;
+ Sprint_Node_List (Actions (Node));
+ Indent_End;
+ Write_Indent;
+ Write_Str_With_Col_Check_Sloc ("in ");
+ Sprint_Node (Expression (Node));
+ Write_Str_With_Col_Check (" end");
+ Indent_End;
+ Write_Indent;
+
when N_Extended_Return_Statement =>
Write_Indent_Str_Sloc ("return ");
Sprint_Node_List (Return_Object_Declarations (Node));
-- Convert wi Rounded_Result target@(source)
-- Divide wi Treat_Fixed_As_Integer x #/ y
-- Divide wi Rounded_Result x @/ y
+ -- Expression with actions do action; .. action; in expr end
-- Expression with range check {expression}
- -- Operator with range check {operator} (e.g. {+})
-- Free statement free expr [storage_pool = xxx]
-- Freeze entity with freeze actions freeze entityname [ actions ]
-- Implicit call to run time routine $routine-name
-- Multiple concatenation expr && expr && expr ... && expr
-- Multiply wi Treat_Fixed_As_Integer x #* y
-- Multiply wi Rounded_Result x @* y
+ -- Operator with range check {operator} (e.g. {+})
-- Others choice for cleanup when all others
-- Pop exception label %pop_xxx_exception_label
-- Push exception label %push_xxx_exception_label (label)
OSDN Git Service
