File : sem_mech.adb
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT COMPILER COMPONENTS --
4 -- --
5 -- S E M _ M E C H --
6 -- --
7 -- B o d y --
8 -- --
9 -- Copyright (C) 1996-2015, 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 Atree; use Atree;
27 with Einfo; use Einfo;
28 with Errout; use Errout;
29 with Namet; use Namet;
30 with Sem; use Sem;
31 with Sem_Aux; use Sem_Aux;
32 with Sinfo; use Sinfo;
33 with Snames; use Snames;
34
35 package body Sem_Mech is
36
37 -------------------------
38 -- Set_Mechanism_Value --
39 -------------------------
40
41 procedure Set_Mechanism_Value (Ent : Entity_Id; Mech_Name : Node_Id) is
42
43 procedure Bad_Mechanism;
44 -- Signal bad mechanism name
45
46 -------------------
47 -- Bad_Mechanism --
48 -------------------
49
50 procedure Bad_Mechanism is
51 begin
52 Error_Msg_N ("unrecognized mechanism name", Mech_Name);
53 end Bad_Mechanism;
54
55 -- Start of processing for Set_Mechanism_Value
56
57 begin
58 if Mechanism (Ent) /= Default_Mechanism then
59 Error_Msg_NE
60 ("mechanism for & has already been set", Mech_Name, Ent);
61 end if;
62
63 -- MECHANISM_NAME ::= value | reference
64
65 if Nkind (Mech_Name) = N_Identifier then
66 if Chars (Mech_Name) = Name_Value then
67 Set_Mechanism_With_Checks (Ent, By_Copy, Mech_Name);
68
69 elsif Chars (Mech_Name) = Name_Reference then
70 Set_Mechanism_With_Checks (Ent, By_Reference, Mech_Name);
71
72 elsif Chars (Mech_Name) = Name_Copy then
73 Error_Msg_N ("bad mechanism name, Value assumed", Mech_Name);
74 Set_Mechanism (Ent, By_Copy);
75
76 else
77 Bad_Mechanism;
78 end if;
79
80 else
81 Bad_Mechanism;
82 end if;
83 end Set_Mechanism_Value;
84
85 -------------------------------
86 -- Set_Mechanism_With_Checks --
87 -------------------------------
88
89 procedure Set_Mechanism_With_Checks
90 (Ent : Entity_Id;
91 Mech : Mechanism_Type;
92 Enod : Node_Id)
93 is
94 pragma Unreferenced (Enod);
95
96 begin
97 -- Right now we don't do any checks, should we do more ???
98
99 Set_Mechanism (Ent, Mech);
100 end Set_Mechanism_With_Checks;
101
102 --------------------
103 -- Set_Mechanisms --
104 --------------------
105
106 procedure Set_Mechanisms (E : Entity_Id) is
107 Formal : Entity_Id;
108 Typ : Entity_Id;
109
110 begin
111 -- Skip this processing if inside a generic template. Not only is
112 -- it unnecessary (since neither extra formals nor mechanisms are
113 -- relevant for the template itself), but at least at the moment,
114 -- procedures get frozen early inside a template so attempting to
115 -- look at the formal types does not work too well if they are
116 -- private types that have not been frozen yet.
117
118 if Inside_A_Generic then
119 return;
120 end if;
121
122 -- Loop through formals
123
124 Formal := First_Formal (E);
125 while Present (Formal) loop
126
127 if Mechanism (Formal) = Default_Mechanism then
128 Typ := Underlying_Type (Etype (Formal));
129
130 -- If there is no underlying type, then skip this processing and
131 -- leave the convention set to Default_Mechanism. It seems odd
132 -- that there should ever be such cases but there are (see
133 -- comments for filed regression tests 1418-001 and 1912-009) ???
134
135 if No (Typ) then
136 goto Skip_Formal;
137 end if;
138
139 case Convention (E) is
140
141 ---------
142 -- Ada --
143 ---------
144
145 -- Note: all RM defined conventions are treated the same from
146 -- the point of view of parameter passing mechanism. Convention
147 -- Ghost has the same dynamic semantics as convention Ada.
148
149 when Convention_Ada |
150 Convention_Intrinsic |
151 Convention_Entry |
152 Convention_Protected |
153 Convention_Stubbed =>
154
155 -- By reference types are passed by reference (RM 6.2(4))
156
157 if Is_By_Reference_Type (Typ) then
158 Set_Mechanism (Formal, By_Reference);
159
160 -- By copy types are passed by copy (RM 6.2(3))
161
162 elsif Is_By_Copy_Type (Typ) then
163 Set_Mechanism (Formal, By_Copy);
164
165 -- All other types we leave the Default_Mechanism set, so
166 -- that the backend can choose the appropriate method.
167
168 else
169 null;
170 end if;
171
172 -- Special Ada conventions specifying passing mechanism
173
174 when Convention_Ada_Pass_By_Copy =>
175 Set_Mechanism (Formal, By_Copy);
176
177 when Convention_Ada_Pass_By_Reference =>
178 Set_Mechanism (Formal, By_Reference);
179
180 -------
181 -- C --
182 -------
183
184 -- Note: Assembler, C++, Stdcall also use C conventions
185
186 when Convention_Assembler |
187 Convention_C |
188 Convention_CPP |
189 Convention_Stdcall =>
190
191 -- The following values are passed by copy
192
193 -- IN Scalar parameters (RM B.3(66))
194 -- IN parameters of access types (RM B.3(67))
195 -- Access parameters (RM B.3(68))
196 -- Access to subprogram types (RM B.3(71))
197
198 -- Note: in the case of access parameters, it is the pointer
199 -- that is passed by value. In GNAT access parameters are
200 -- treated as IN parameters of an anonymous access type, so
201 -- this falls out free.
202
203 -- The bottom line is that all IN elementary types are
204 -- passed by copy in GNAT.
205
206 if Is_Elementary_Type (Typ) then
207 if Ekind (Formal) = E_In_Parameter then
208 Set_Mechanism (Formal, By_Copy);
209
210 -- OUT and IN OUT parameters of elementary types are
211 -- passed by reference (RM B.3(68)). Note that we are
212 -- not following the advice to pass the address of a
213 -- copy to preserve by copy semantics.
214
215 else
216 Set_Mechanism (Formal, By_Reference);
217 end if;
218
219 -- Records are normally passed by reference (RM B.3(69)).
220 -- However, this can be overridden by the use of the
221 -- C_Pass_By_Copy pragma or C_Pass_By_Copy convention.
222
223 elsif Is_Record_Type (Typ) then
224
225 -- If the record is not convention C, then we always
226 -- pass by reference, C_Pass_By_Copy does not apply.
227
228 if Convention (Typ) /= Convention_C then
229 Set_Mechanism (Formal, By_Reference);
230
231 -- OUT and IN OUT parameters of record types are passed
232 -- by reference regardless of pragmas (RM B.3 (69/2)).
233
234 elsif Ekind_In (Formal, E_Out_Parameter,
235 E_In_Out_Parameter)
236 then
237 Set_Mechanism (Formal, By_Reference);
238
239 -- IN parameters of record types are passed by copy only
240 -- when the related type has convention C_Pass_By_Copy
241 -- (RM B.3 (68.1/2)).
242
243 elsif Ekind (Formal) = E_In_Parameter
244 and then C_Pass_By_Copy (Typ)
245 then
246 Set_Mechanism (Formal, By_Copy);
247
248 -- Otherwise, for a C convention record, we set the
249 -- convention in accordance with a possible use of
250 -- the C_Pass_By_Copy pragma. Note that the value of
251 -- Default_C_Record_Mechanism in the absence of such
252 -- a pragma is By_Reference.
253
254 else
255 Set_Mechanism (Formal, Default_C_Record_Mechanism);
256 end if;
257
258 -- Array types are passed by reference (B.3 (71))
259
260 elsif Is_Array_Type (Typ) then
261 Set_Mechanism (Formal, By_Reference);
262
263 -- For all other types, use Default_Mechanism mechanism
264
265 else
266 null;
267 end if;
268
269 -----------
270 -- COBOL --
271 -----------
272
273 when Convention_COBOL =>
274
275 -- Access parameters (which in GNAT look like IN parameters
276 -- of an access type) are passed by copy (RM B.4(96)) as
277 -- are all other IN parameters of scalar type (RM B.4(97)).
278
279 -- For now we pass these parameters by reference as well.
280 -- The RM specifies the intent BY_CONTENT, but gigi does
281 -- not currently transform By_Copy properly. If we pass by
282 -- reference, it will be imperative to introduce copies ???
283
284 if Is_Elementary_Type (Typ)
285 and then Ekind (Formal) = E_In_Parameter
286 then
287 Set_Mechanism (Formal, By_Reference);
288
289 -- All other parameters (i.e. all non-scalar types, and
290 -- all OUT or IN OUT parameters) are passed by reference.
291 -- Note that at the moment we are not bothering to make
292 -- copies of scalar types as recommended in the RM.
293
294 else
295 Set_Mechanism (Formal, By_Reference);
296 end if;
297
298 -------------
299 -- Fortran --
300 -------------
301
302 when Convention_Fortran =>
303
304 -- Access types are passed by default (presumably this
305 -- will mean they are passed by copy)
306
307 if Is_Access_Type (Typ) then
308 null;
309
310 -- For now, we pass all other parameters by reference.
311 -- It is not clear that this is right in the long run,
312 -- but it seems to correspond to what gnu f77 wants.
313
314 else
315 Set_Mechanism (Formal, By_Reference);
316 end if;
317 end case;
318 end if;
319
320 <<Skip_Formal>> -- remove this when problem above is fixed ???
321
322 Next_Formal (Formal);
323 end loop;
324
325 -- Note: there is nothing we need to do for the return type here.
326 -- We deal with returning by reference in the Ada sense, by use of
327 -- the flag By_Ref, rather than by messing with mechanisms.
328
329 -- A mechanism of Reference for the return means that an extra
330 -- parameter must be provided for the return value (that is the
331 -- DEC meaning of the pragma), and is unrelated to the Ada notion
332 -- of return by reference.
333
334 -- Note: there was originally code here to set the mechanism to
335 -- By_Reference for types that are "by reference" in the Ada sense,
336 -- but, in accordance with the discussion above, this is wrong, and
337 -- the code was removed.
338
339 end Set_Mechanisms;
340
341 end Sem_Mech;