diff options
| -rw-r--r-- | gcc/ada/exp_ch9.adb | 38 | ||||
| -rw-r--r-- | gcc/ada/sem_util.adb | 107 | ||||
| -rw-r--r-- | gcc/ada/sem_util.ads | 10 |
3 files changed, 30 insertions, 125 deletions
diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb index df4a083..68f1290 100644 --- a/gcc/ada/exp_ch9.adb +++ b/gcc/ada/exp_ch9.adb @@ -7712,7 +7712,7 @@ package body Exp_Ch9 is -- or else K = Ada.Tags.TK_Tagged -- then -- <dispatching-call>; - -- <triggering-statements> + -- -- <triggering-statements> (code factorized after if-stmt) -- else -- S := @@ -7737,11 +7737,14 @@ package body Exp_Ch9 is -- <dispatching-call>; -- end if; - -- <triggering-statements> + -- -- <triggering-statements> (code factorized after if-stmt) -- else -- <else-statements> + -- goto L0; -- skip triggering statements -- end if; -- end if; + -- <triggering-statements> + -- L0: -- end; procedure Expand_N_Conditional_Entry_Call (N : Node_Id) is @@ -7757,6 +7760,8 @@ package body Exp_Ch9 is Decl : Node_Id; Decls : List_Id; Formals : List_Id; + Label : Node_Id; + Label_Id : Entity_Id := Empty; Lim_Typ_Stmts : List_Id; N_Stats : List_Id; Obj : Entity_Id; @@ -7883,12 +7888,13 @@ package body Exp_Ch9 is -- then -- <dispatching-call> -- end if; - -- <normal-statements> + -- -- <triggering-stataments> (code factorized after if-stmt) -- else -- <else-statements> + -- goto L0; -- skip triggering statements -- end if; - N_Stats := New_Copy_Separate_List (Statements (Alt)); + N_Stats := New_List; Prepend_To (N_Stats, Make_Implicit_If_Statement (N, @@ -7922,6 +7928,14 @@ package body Exp_Ch9 is Then_Statements => New_List (Blk))); + Label_Id := Make_Identifier (Loc, New_External_Name ('L', 0)); + Set_Entity (Label_Id, + Make_Defining_Identifier (Loc, Chars (Label_Id))); + + Append_To (Else_Statements (N), + Make_Goto_Statement (Loc, + Name => New_Occurrence_Of (Entity (Label_Id), Loc))); + Append_To (Conc_Typ_Stmts, Make_Implicit_If_Statement (N, Condition => New_Occurrence_Of (B, Loc), @@ -7930,15 +7944,14 @@ package body Exp_Ch9 is -- Generate: -- <dispatching-call>; - -- <triggering-statements> + -- -- <triggering-statements> (code factorized after if-stmt) - Lim_Typ_Stmts := New_Copy_Separate_List (Statements (Alt)); - Prepend_To (Lim_Typ_Stmts, New_Copy_Tree (Blk)); + Lim_Typ_Stmts := New_List (New_Copy_Tree (Blk)); -- Generate: -- if K = Ada.Tags.TK_Limited_Tagged -- or else K = Ada.Tags.TK_Tagged - -- then + -- then -- Lim_Typ_Stmts -- else -- Conc_Typ_Stmts @@ -7950,6 +7963,15 @@ package body Exp_Ch9 is Then_Statements => Lim_Typ_Stmts, Else_Statements => Conc_Typ_Stmts)); + Label := Make_Label (Loc, Label_Id); + Append_To (Decls, + Make_Implicit_Label_Declaration (Loc, + Defining_Identifier => Entity (Label_Id), + Label_Construct => Label)); + + Append_List_To (Stmts, Statements (Alt)); -- triggering-statements + Append_To (Stmts, Label); + Rewrite (N, Make_Block_Statement (Loc, Declarations => diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index d15e20b..64c12cc 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -22886,113 +22886,6 @@ package body Sem_Util is end if; end New_Copy_List_Tree; - ---------------------------- - -- New_Copy_Separate_List -- - ---------------------------- - - function New_Copy_Separate_List (List : List_Id) return List_Id is - begin - if List = No_List then - return No_List; - - else - declare - List_Copy : constant List_Id := New_List; - N : Node_Id := First (List); - - begin - while Present (N) loop - Append (New_Copy_Separate_Tree (N), List_Copy); - Next (N); - end loop; - - return List_Copy; - end; - end if; - end New_Copy_Separate_List; - - ---------------------------- - -- New_Copy_Separate_Tree -- - ---------------------------- - - function New_Copy_Separate_Tree (Source : Node_Id) return Node_Id is - function Search_Decl (N : Node_Id) return Traverse_Result; - -- Subtree visitor which collects declarations - - procedure Search_Declarations is new Traverse_Proc (Search_Decl); - -- Subtree visitor instantiation - - ----------------- - -- Search_Decl -- - ----------------- - - Decls : Elist_Id; - - function Search_Decl (N : Node_Id) return Traverse_Result is - begin - if Nkind (N) in N_Declaration then - Append_New_Elmt (N, Decls); - end if; - - return OK; - end Search_Decl; - - -- Local variables - - Source_Copy : constant Node_Id := New_Copy_Tree (Source); - - -- Start of processing for New_Copy_Separate_Tree - - begin - Decls := No_Elist; - Search_Declarations (Source_Copy); - - -- Associate a new Entity with all the subtree declarations (keeping - -- their original name). - - if Present (Decls) then - declare - Elmt : Elmt_Id; - Decl : Node_Id; - New_E : Entity_Id; - - begin - Elmt := First_Elmt (Decls); - while Present (Elmt) loop - Decl := Node (Elmt); - New_E := Make_Temporary (Sloc (Decl), 'P'); - - if Nkind (Decl) = N_Expression_Function then - Decl := Specification (Decl); - end if; - - if Nkind (Decl) in N_Function_Instantiation - | N_Function_Specification - | N_Generic_Function_Renaming_Declaration - | N_Generic_Package_Renaming_Declaration - | N_Generic_Procedure_Renaming_Declaration - | N_Package_Body - | N_Package_Instantiation - | N_Package_Renaming_Declaration - | N_Package_Specification - | N_Procedure_Instantiation - | N_Procedure_Specification - then - Set_Chars (New_E, Chars (Defining_Unit_Name (Decl))); - Set_Defining_Unit_Name (Decl, New_E); - else - Set_Chars (New_E, Chars (Defining_Identifier (Decl))); - Set_Defining_Identifier (Decl, New_E); - end if; - - Next_Elmt (Elmt); - end loop; - end; - end if; - - return Source_Copy; - end New_Copy_Separate_Tree; - ------------------- -- New_Copy_Tree -- ------------------- diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads index 6f5b20e..b5bcd26 100644 --- a/gcc/ada/sem_util.ads +++ b/gcc/ada/sem_util.ads @@ -2623,16 +2623,6 @@ package Sem_Util is -- below. As for New_Copy_Tree, it is illegal to attempt to copy extended -- nodes (entities) either directly or indirectly using this function. - function New_Copy_Separate_List (List : List_Id) return List_Id; - -- Copy recursively a list of nodes using New_Copy_Separate_Tree - - function New_Copy_Separate_Tree (Source : Node_Id) return Node_Id; - -- Perform a deep copy of the subtree rooted at Source using New_Copy_Tree - -- replacing entities of local declarations by new entities. This behavior - -- is required by the backend to ensure entities uniqueness when a copy of - -- a subtree is attached to the tree. The new entities keep their original - -- names to facilitate debugging the tree copy. - function New_Copy_Tree (Source : Node_Id; Map : Elist_Id := No_Elist; |