diff options
Diffstat (limited to 'gcc-4.8/gcc/ada/exp_sel.adb')
| -rw-r--r-- | gcc-4.8/gcc/ada/exp_sel.adb | 263 |
1 files changed, 0 insertions, 263 deletions
diff --git a/gcc-4.8/gcc/ada/exp_sel.adb b/gcc-4.8/gcc/ada/exp_sel.adb deleted file mode 100644 index 27245cff5..000000000 --- a/gcc-4.8/gcc/ada/exp_sel.adb +++ /dev/null @@ -1,263 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT COMPILER COMPONENTS -- --- -- --- E X P _ S E L -- --- -- --- B o d y -- --- -- --- 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- -- --- ware Foundation; either version 3, or (at your option) any later ver- -- --- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- --- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- --- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- --- for more details. You should have received a copy of the GNU General -- --- Public License distributed with GNAT; see file COPYING3. If not, go to -- --- http://www.gnu.org/licenses for a complete copy of the license. -- --- -- --- GNAT was originally developed by the GNAT team at New York University. -- --- Extensive contributions were provided by Ada Core Technologies Inc. -- --- -- ------------------------------------------------------------------------------- - -with Einfo; use Einfo; -with Nlists; use Nlists; -with Nmake; use Nmake; -with Opt; use Opt; -with Rtsfind; use Rtsfind; -with Sinfo; use Sinfo; -with Snames; use Snames; -with Stand; use Stand; -with Tbuild; use Tbuild; - -package body Exp_Sel is - - ----------------------- - -- Build_Abort_Block -- - ----------------------- - - function Build_Abort_Block - (Loc : Source_Ptr; - Abr_Blk_Ent : Entity_Id; - Cln_Blk_Ent : Entity_Id; - Blk : Node_Id) return Node_Id - is - begin - return - Make_Block_Statement (Loc, - Identifier => New_Reference_To (Abr_Blk_Ent, Loc), - - Declarations => No_List, - - Handled_Statement_Sequence => - Make_Handled_Sequence_Of_Statements (Loc, - Statements => - New_List ( - Make_Implicit_Label_Declaration (Loc, - Defining_Identifier => Cln_Blk_Ent, - Label_Construct => Blk), - Blk), - - Exception_Handlers => - New_List (Build_Abort_Block_Handler (Loc)))); - end Build_Abort_Block; - - ------------------------------- - -- Build_Abort_Block_Handler -- - ------------------------------- - - function Build_Abort_Block_Handler (Loc : Source_Ptr) return Node_Id is - Stmt : Node_Id; - - begin - if Exception_Mechanism = Back_End_Exceptions then - - -- With ZCX, aborts are not defered in handlers - - Stmt := Make_Null_Statement (Loc); - else - -- With FE SJLJ, aborts are defered at the beginning of Abort_Signal - -- handlers. - - Stmt := - Make_Procedure_Call_Statement (Loc, - Name => New_Reference_To (RTE (RE_Abort_Undefer), Loc), - Parameter_Associations => No_List); - end if; - - return Make_Implicit_Exception_Handler (Loc, - Exception_Choices => - New_List (New_Reference_To (Stand.Abort_Signal, Loc)), - Statements => New_List (Stmt)); - end Build_Abort_Block_Handler; - - ------------- - -- Build_B -- - ------------- - - function Build_B - (Loc : Source_Ptr; - Decls : List_Id) return Entity_Id - is - B : constant Entity_Id := Make_Temporary (Loc, 'B'); - begin - Append_To (Decls, - Make_Object_Declaration (Loc, - Defining_Identifier => B, - Object_Definition => New_Reference_To (Standard_Boolean, Loc), - Expression => New_Reference_To (Standard_False, Loc))); - return B; - end Build_B; - - ------------- - -- Build_C -- - ------------- - - function Build_C - (Loc : Source_Ptr; - Decls : List_Id) return Entity_Id - is - C : constant Entity_Id := Make_Temporary (Loc, 'C'); - begin - Append_To (Decls, - Make_Object_Declaration (Loc, - Defining_Identifier => C, - Object_Definition => New_Reference_To (RTE (RE_Prim_Op_Kind), Loc))); - return C; - end Build_C; - - ------------------------- - -- Build_Cleanup_Block -- - ------------------------- - - function Build_Cleanup_Block - (Loc : Source_Ptr; - Blk_Ent : Entity_Id; - Stmts : List_Id; - Clean_Ent : Entity_Id) return Node_Id - is - Cleanup_Block : constant Node_Id := - Make_Block_Statement (Loc, - Identifier => - New_Reference_To (Blk_Ent, Loc), - Declarations => No_List, - Handled_Statement_Sequence => - Make_Handled_Sequence_Of_Statements (Loc, - Statements => Stmts), - Is_Asynchronous_Call_Block => True); - - begin - Set_Entry_Cancel_Parameter (Blk_Ent, Clean_Ent); - - return Cleanup_Block; - end Build_Cleanup_Block; - - ------------- - -- Build_K -- - ------------- - - function Build_K - (Loc : Source_Ptr; - Decls : List_Id; - Obj : Entity_Id) return Entity_Id - is - K : constant Entity_Id := Make_Temporary (Loc, 'K'); - Tag_Node : Node_Id; - - begin - if Tagged_Type_Expansion then - Tag_Node := Unchecked_Convert_To (RTE (RE_Tag), Obj); - else - Tag_Node := - Make_Attribute_Reference (Loc, - Prefix => Obj, - Attribute_Name => Name_Tag); - end if; - - Append_To (Decls, - Make_Object_Declaration (Loc, - Defining_Identifier => K, - Object_Definition => - New_Reference_To (RTE (RE_Tagged_Kind), Loc), - Expression => - Make_Function_Call (Loc, - Name => New_Reference_To (RTE (RE_Get_Tagged_Kind), Loc), - Parameter_Associations => New_List (Tag_Node)))); - return K; - end Build_K; - - ------------- - -- Build_S -- - ------------- - - function Build_S - (Loc : Source_Ptr; - Decls : List_Id) return Entity_Id - is - S : constant Entity_Id := Make_Temporary (Loc, 'S'); - begin - Append_To (Decls, - Make_Object_Declaration (Loc, - Defining_Identifier => S, - Object_Definition => New_Reference_To (Standard_Integer, Loc))); - return S; - end Build_S; - - ------------------------ - -- Build_S_Assignment -- - ------------------------ - - function Build_S_Assignment - (Loc : Source_Ptr; - S : Entity_Id; - Obj : Entity_Id; - Call_Ent : Entity_Id) return Node_Id - is - Typ : constant Entity_Id := Etype (Obj); - - begin - if Tagged_Type_Expansion then - return - Make_Assignment_Statement (Loc, - Name => New_Reference_To (S, Loc), - Expression => - Make_Function_Call (Loc, - Name => New_Reference_To (RTE (RE_Get_Offset_Index), Loc), - Parameter_Associations => New_List ( - Unchecked_Convert_To (RTE (RE_Tag), Obj), - Make_Integer_Literal (Loc, DT_Position (Call_Ent))))); - - -- VM targets - - else - return - Make_Assignment_Statement (Loc, - Name => New_Reference_To (S, Loc), - Expression => - Make_Function_Call (Loc, - Name => New_Reference_To (RTE (RE_Get_Offset_Index), Loc), - - Parameter_Associations => New_List ( - - -- Obj_Typ - - Make_Attribute_Reference (Loc, - Prefix => Obj, - Attribute_Name => Name_Tag), - - -- Iface_Typ - - Make_Attribute_Reference (Loc, - Prefix => New_Reference_To (Typ, Loc), - Attribute_Name => Name_Tag), - - -- Position - - Make_Integer_Literal (Loc, DT_Position (Call_Ent))))); - end if; - end Build_S_Assignment; - -end Exp_Sel; |