aboutsummaryrefslogtreecommitdiffstats
path: root/gcc-4.2.1/gcc/ada/exp_sel.adb
diff options
context:
space:
mode:
Diffstat (limited to 'gcc-4.2.1/gcc/ada/exp_sel.adb')
-rw-r--r--gcc-4.2.1/gcc/ada/exp_sel.adb220
1 files changed, 0 insertions, 220 deletions
diff --git a/gcc-4.2.1/gcc/ada/exp_sel.adb b/gcc-4.2.1/gcc/ada/exp_sel.adb
deleted file mode 100644
index dbb7fb290..000000000
--- a/gcc-4.2.1/gcc/ada/exp_sel.adb
+++ /dev/null
@@ -1,220 +0,0 @@
-------------------------------------------------------------------------------
--- --
--- GNAT COMPILER COMPONENTS --
--- --
--- E X P _ S E L --
--- --
--- B o d y --
--- --
--- Copyright (C) 1992-2005, 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 2, 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 COPYING. If not, write --
--- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
--- Boston, MA 02110-1301, USA. --
--- --
--- 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 Rtsfind; use Rtsfind;
-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 (
- Make_Exception_Handler (Loc,
- Exception_Choices =>
- New_List (
- New_Reference_To (Stand.Abort_Signal, Loc)),
- Statements =>
- New_List (
- Make_Procedure_Call_Statement (Loc,
- Name =>
- New_Reference_To (RTE (
- RE_Abort_Undefer), Loc),
- Parameter_Associations => No_List))))));
- end Build_Abort_Block;
-
- -------------
- -- Build_B --
- -------------
-
- function Build_B
- (Loc : Source_Ptr;
- Decls : List_Id) return Entity_Id
- is
- B : constant Entity_Id := Make_Defining_Identifier (Loc,
- Chars => New_Internal_Name ('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_Defining_Identifier (Loc,
- Chars => New_Internal_Name ('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_Defining_Identifier (Loc,
- Chars => New_Internal_Name ('K'));
-
- begin
- 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 (
- Unchecked_Convert_To (RTE (RE_Tag), Obj)))));
-
- 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_Defining_Identifier (Loc,
- Chars => New_Internal_Name ('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
- begin
- 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)))));
- end Build_S_Assignment;
-
-end Exp_Sel;