OpenCores
URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-stable/] [gcc-4.5.1/] [gcc/] [ada/] [exp_sel.adb] - Blame information for rev 826

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 281 jeremybenn
------------------------------------------------------------------------------
2
--                                                                          --
3
--                         GNAT COMPILER COMPONENTS                         --
4
--                                                                          --
5
--                              E X P _ S E L                               --
6
--                                                                          --
7
--                                 B o d y                                  --
8
--                                                                          --
9
--          Copyright (C) 1992-2007, Free Software Foundation, Inc.         --
10
--                                                                          --
11
-- GNAT is free software;  you can  redistribute it  and/or modify it under --
12
-- terms of the  GNU General Public License as published  by the Free Soft- --
13
-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
14
-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
15
-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
16
-- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
17
-- for  more details.  You should have  received  a copy of the GNU General --
18
-- Public License  distributed with GNAT; see file COPYING3.  If not, go to --
19
-- http://www.gnu.org/licenses for a complete copy of the license.          --
20
--                                                                          --
21
-- GNAT was originally developed  by the GNAT team at  New York University. --
22
-- Extensive contributions were provided by Ada Core Technologies Inc.      --
23
--                                                                          --
24
------------------------------------------------------------------------------
25
 
26
with Einfo;   use Einfo;
27
with Nlists;  use Nlists;
28
with Nmake;   use Nmake;
29
with Rtsfind; use Rtsfind;
30
with Stand;   use Stand;
31
with Tbuild;  use Tbuild;
32
 
33
package body Exp_Sel is
34
 
35
   -----------------------
36
   -- Build_Abort_Block --
37
   -----------------------
38
 
39
   function Build_Abort_Block
40
     (Loc         : Source_Ptr;
41
      Abr_Blk_Ent : Entity_Id;
42
      Cln_Blk_Ent : Entity_Id;
43
      Blk         : Node_Id) return Node_Id
44
   is
45
   begin
46
      return
47
        Make_Block_Statement (Loc,
48
          Identifier   => New_Reference_To (Abr_Blk_Ent, Loc),
49
 
50
          Declarations => No_List,
51
 
52
          Handled_Statement_Sequence =>
53
            Make_Handled_Sequence_Of_Statements (Loc,
54
              Statements =>
55
                New_List (
56
                  Make_Implicit_Label_Declaration (Loc,
57
                    Defining_Identifier =>
58
                      Cln_Blk_Ent,
59
                    Label_Construct =>
60
                      Blk),
61
                  Blk),
62
 
63
              Exception_Handlers =>
64
                New_List (
65
                  Make_Implicit_Exception_Handler (Loc,
66
                    Exception_Choices =>
67
                      New_List (
68
                        New_Reference_To (Stand.Abort_Signal, Loc)),
69
                    Statements =>
70
                      New_List (
71
                        Make_Procedure_Call_Statement (Loc,
72
                          Name =>
73
                            New_Reference_To (RTE (
74
                              RE_Abort_Undefer), Loc),
75
                          Parameter_Associations => No_List))))));
76
   end Build_Abort_Block;
77
 
78
   -------------
79
   -- Build_B --
80
   -------------
81
 
82
   function Build_B
83
     (Loc   : Source_Ptr;
84
      Decls : List_Id) return Entity_Id
85
   is
86
      B : constant Entity_Id := Make_Defining_Identifier (Loc,
87
                                  Chars => New_Internal_Name ('B'));
88
 
89
   begin
90
      Append_To (Decls,
91
        Make_Object_Declaration (Loc,
92
          Defining_Identifier =>
93
            B,
94
          Object_Definition =>
95
            New_Reference_To (Standard_Boolean, Loc),
96
          Expression =>
97
            New_Reference_To (Standard_False, Loc)));
98
 
99
      return B;
100
   end Build_B;
101
 
102
   -------------
103
   -- Build_C --
104
   -------------
105
 
106
   function Build_C
107
     (Loc   : Source_Ptr;
108
      Decls : List_Id) return Entity_Id
109
   is
110
      C : constant Entity_Id := Make_Defining_Identifier (Loc,
111
                                  Chars => New_Internal_Name ('C'));
112
 
113
   begin
114
      Append_To (Decls,
115
        Make_Object_Declaration (Loc,
116
          Defining_Identifier =>
117
            C,
118
          Object_Definition =>
119
            New_Reference_To (RTE (RE_Prim_Op_Kind), Loc)));
120
 
121
      return C;
122
   end Build_C;
123
 
124
   -------------------------
125
   -- Build_Cleanup_Block --
126
   -------------------------
127
 
128
   function Build_Cleanup_Block
129
     (Loc       : Source_Ptr;
130
      Blk_Ent   : Entity_Id;
131
      Stmts     : List_Id;
132
      Clean_Ent : Entity_Id) return Node_Id
133
   is
134
      Cleanup_Block : constant Node_Id :=
135
                        Make_Block_Statement (Loc,
136
                          Identifier   => New_Reference_To (Blk_Ent, Loc),
137
                          Declarations => No_List,
138
                          Handled_Statement_Sequence =>
139
                            Make_Handled_Sequence_Of_Statements (Loc,
140
                              Statements => Stmts),
141
                          Is_Asynchronous_Call_Block => True);
142
 
143
   begin
144
      Set_Entry_Cancel_Parameter (Blk_Ent, Clean_Ent);
145
 
146
      return Cleanup_Block;
147
   end Build_Cleanup_Block;
148
 
149
   -------------
150
   -- Build_K --
151
   -------------
152
 
153
   function Build_K
154
     (Loc   : Source_Ptr;
155
      Decls : List_Id;
156
      Obj   : Entity_Id) return Entity_Id
157
   is
158
      K : constant Entity_Id := Make_Defining_Identifier (Loc,
159
                                  Chars => New_Internal_Name ('K'));
160
 
161
   begin
162
      Append_To (Decls,
163
        Make_Object_Declaration (Loc,
164
          Defining_Identifier => K,
165
          Object_Definition   =>
166
            New_Reference_To (RTE (RE_Tagged_Kind), Loc),
167
          Expression          =>
168
            Make_Function_Call (Loc,
169
              Name => New_Reference_To (RTE (RE_Get_Tagged_Kind), Loc),
170
              Parameter_Associations => New_List (
171
                Unchecked_Convert_To (RTE (RE_Tag), Obj)))));
172
 
173
      return K;
174
   end Build_K;
175
 
176
   -------------
177
   -- Build_S --
178
   -------------
179
 
180
   function Build_S
181
     (Loc   : Source_Ptr;
182
      Decls : List_Id) return Entity_Id
183
   is
184
      S : constant Entity_Id := Make_Defining_Identifier (Loc,
185
                                  Chars => New_Internal_Name ('S'));
186
 
187
   begin
188
      Append_To (Decls,
189
        Make_Object_Declaration (Loc,
190
          Defining_Identifier => S,
191
          Object_Definition   =>
192
            New_Reference_To (Standard_Integer, Loc)));
193
 
194
      return S;
195
   end Build_S;
196
 
197
   ------------------------
198
   -- Build_S_Assignment --
199
   ------------------------
200
 
201
   function Build_S_Assignment
202
     (Loc      : Source_Ptr;
203
      S        : Entity_Id;
204
      Obj      : Entity_Id;
205
      Call_Ent : Entity_Id) return Node_Id
206
   is
207
   begin
208
      return
209
        Make_Assignment_Statement (Loc,
210
          Name => New_Reference_To (S, Loc),
211
          Expression =>
212
            Make_Function_Call (Loc,
213
              Name => New_Reference_To (RTE (RE_Get_Offset_Index), Loc),
214
              Parameter_Associations => New_List (
215
                Unchecked_Convert_To (RTE (RE_Tag), Obj),
216
                Make_Integer_Literal (Loc, DT_Position (Call_Ent)))));
217
   end Build_S_Assignment;
218
 
219
end Exp_Sel;

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.