1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1996-2011, Free Software Foundation, Inc. --
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. --
21 -- GNAT was originally developed by the GNAT team at New York University. --
22 -- Extensive contributions were provided by Ada Core Technologies Inc. --
24 ------------------------------------------------------------------------------
26 with Atree; use Atree;
27 with Einfo; use Einfo;
28 with Errout; use Errout;
29 with Namet; use Namet;
30 with Nlists; use Nlists;
32 with Sem_Aux; use Sem_Aux;
33 with Sem_Util; use Sem_Util;
34 with Sinfo; use Sinfo;
35 with Snames; use Snames;
36 with Stand; use Stand;
37 with Targparm; use Targparm;
39 package body Sem_Mech is
41 -------------------------
42 -- Set_Mechanism_Value --
43 -------------------------
45 procedure Set_Mechanism_Value (Ent : Entity_Id; Mech_Name : Node_Id) is
50 -- Signal bad descriptor class name
52 procedure Bad_Mechanism;
53 -- Signal bad mechanism name
55 procedure Bad_Class is
57 Error_Msg_N ("unrecognized descriptor class name", Class);
60 procedure Bad_Mechanism is
62 Error_Msg_N ("unrecognized mechanism name", Mech_Name);
65 -- Start of processing for Set_Mechanism_Value
68 if Mechanism (Ent) /= Default_Mechanism then
70 ("mechanism for & has already been set", Mech_Name, Ent);
73 -- MECHANISM_NAME ::= value | reference | descriptor | short_descriptor
75 if Nkind (Mech_Name) = N_Identifier then
76 if Chars (Mech_Name) = Name_Value then
77 Set_Mechanism_With_Checks (Ent, By_Copy, Mech_Name);
80 elsif Chars (Mech_Name) = Name_Reference then
81 Set_Mechanism_With_Checks (Ent, By_Reference, Mech_Name);
84 elsif Chars (Mech_Name) = Name_Descriptor then
85 Check_VMS (Mech_Name);
86 Set_Mechanism_With_Checks (Ent, By_Descriptor, Mech_Name);
89 elsif Chars (Mech_Name) = Name_Short_Descriptor then
90 Check_VMS (Mech_Name);
91 Set_Mechanism_With_Checks (Ent, By_Short_Descriptor, Mech_Name);
94 elsif Chars (Mech_Name) = Name_Copy then
95 Error_Msg_N ("bad mechanism name, Value assumed", Mech_Name);
96 Set_Mechanism (Ent, By_Copy);
103 -- MECHANISM_NAME ::= descriptor (CLASS_NAME) |
104 -- short_descriptor (CLASS_NAME)
105 -- CLASS_NAME ::= ubs | ubsb | uba | s | sb | a | nca
107 -- Note: this form is parsed as an indexed component
109 elsif Nkind (Mech_Name) = N_Indexed_Component then
110 Class := First (Expressions (Mech_Name));
112 if Nkind (Prefix (Mech_Name)) /= N_Identifier
113 or else not (Chars (Prefix (Mech_Name)) = Name_Descriptor or else
114 Chars (Prefix (Mech_Name)) = Name_Short_Descriptor)
115 or else Present (Next (Class))
121 -- MECHANISM_NAME ::= descriptor (Class => CLASS_NAME) |
122 -- short_descriptor (Class => CLASS_NAME)
123 -- CLASS_NAME ::= ubs | ubsb | uba | s | sb | a | nca
125 -- Note: this form is parsed as a function call
127 elsif Nkind (Mech_Name) = N_Function_Call then
129 Param := First (Parameter_Associations (Mech_Name));
131 if Nkind (Name (Mech_Name)) /= N_Identifier
132 or else not (Chars (Name (Mech_Name)) = Name_Descriptor or else
133 Chars (Name (Mech_Name)) = Name_Short_Descriptor)
134 or else Present (Next (Param))
135 or else No (Selector_Name (Param))
136 or else Chars (Selector_Name (Param)) /= Name_Class
141 Class := Explicit_Actual_Parameter (Param);
149 -- Fall through here with Class set to descriptor class name
151 Check_VMS (Mech_Name);
153 if Nkind (Class) /= N_Identifier then
157 elsif Chars (Name (Mech_Name)) = Name_Descriptor
158 and then Chars (Class) = Name_UBS
160 Set_Mechanism_With_Checks (Ent, By_Descriptor_UBS, Mech_Name);
162 elsif Chars (Name (Mech_Name)) = Name_Descriptor
163 and then Chars (Class) = Name_UBSB
165 Set_Mechanism_With_Checks (Ent, By_Descriptor_UBSB, Mech_Name);
167 elsif Chars (Name (Mech_Name)) = Name_Descriptor
168 and then Chars (Class) = Name_UBA
170 Set_Mechanism_With_Checks (Ent, By_Descriptor_UBA, Mech_Name);
172 elsif Chars (Name (Mech_Name)) = Name_Descriptor
173 and then Chars (Class) = Name_S
175 Set_Mechanism_With_Checks (Ent, By_Descriptor_S, Mech_Name);
177 elsif Chars (Name (Mech_Name)) = Name_Descriptor
178 and then Chars (Class) = Name_SB
180 Set_Mechanism_With_Checks (Ent, By_Descriptor_SB, Mech_Name);
182 elsif Chars (Name (Mech_Name)) = Name_Descriptor
183 and then Chars (Class) = Name_A
185 Set_Mechanism_With_Checks (Ent, By_Descriptor_A, Mech_Name);
187 elsif Chars (Name (Mech_Name)) = Name_Descriptor
188 and then Chars (Class) = Name_NCA
190 Set_Mechanism_With_Checks (Ent, By_Descriptor_NCA, Mech_Name);
192 elsif Chars (Name (Mech_Name)) = Name_Short_Descriptor
193 and then Chars (Class) = Name_UBS
195 Set_Mechanism_With_Checks (Ent, By_Short_Descriptor_UBS, Mech_Name);
197 elsif Chars (Name (Mech_Name)) = Name_Short_Descriptor
198 and then Chars (Class) = Name_UBSB
200 Set_Mechanism_With_Checks (Ent, By_Short_Descriptor_UBSB, Mech_Name);
202 elsif Chars (Name (Mech_Name)) = Name_Short_Descriptor
203 and then Chars (Class) = Name_UBA
205 Set_Mechanism_With_Checks (Ent, By_Short_Descriptor_UBA, Mech_Name);
207 elsif Chars (Name (Mech_Name)) = Name_Short_Descriptor
208 and then Chars (Class) = Name_S
210 Set_Mechanism_With_Checks (Ent, By_Short_Descriptor_S, Mech_Name);
212 elsif Chars (Name (Mech_Name)) = Name_Short_Descriptor
213 and then Chars (Class) = Name_SB
215 Set_Mechanism_With_Checks (Ent, By_Short_Descriptor_SB, Mech_Name);
217 elsif Chars (Name (Mech_Name)) = Name_Short_Descriptor
218 and then Chars (Class) = Name_A
220 Set_Mechanism_With_Checks (Ent, By_Short_Descriptor_A, Mech_Name);
222 elsif Chars (Name (Mech_Name)) = Name_Short_Descriptor
223 and then Chars (Class) = Name_NCA
225 Set_Mechanism_With_Checks (Ent, By_Short_Descriptor_NCA, Mech_Name);
231 end Set_Mechanism_Value;
233 -------------------------------
234 -- Set_Mechanism_With_Checks --
235 -------------------------------
237 procedure Set_Mechanism_With_Checks
239 Mech : Mechanism_Type;
243 -- Right now we only do some checks for functions returning arguments
244 -- by descriptor. Probably mode checks need to be added here ???
246 if Mech in Descriptor_Codes and then not Is_Formal (Ent) then
247 if Is_Record_Type (Etype (Ent)) then
248 Error_Msg_N ("?records cannot be returned by Descriptor", Enod);
253 -- If we fall through, all checks have passed
255 Set_Mechanism (Ent, Mech);
256 end Set_Mechanism_With_Checks;
262 procedure Set_Mechanisms (E : Entity_Id) is
267 -- Skip this processing if inside a generic template. Not only is
268 -- it unnecessary (since neither extra formals nor mechanisms are
269 -- relevant for the template itself), but at least at the moment,
270 -- procedures get frozen early inside a template so attempting to
271 -- look at the formal types does not work too well if they are
272 -- private types that have not been frozen yet.
274 if Inside_A_Generic then
278 -- Loop through formals
280 Formal := First_Formal (E);
281 while Present (Formal) loop
283 if Mechanism (Formal) = Default_Mechanism then
284 Typ := Underlying_Type (Etype (Formal));
286 -- If there is no underlying type, then skip this processing and
287 -- leave the convention set to Default_Mechanism. It seems odd
288 -- that there should ever be such cases but there are (see
289 -- comments for filed regression tests 1418-001 and 1912-009) ???
295 case Convention (E) is
301 -- Note: all RM defined conventions are treated the same
302 -- from the point of view of parameter passing mechanism
304 when Convention_Ada |
305 Convention_Intrinsic |
307 Convention_Protected |
308 Convention_Stubbed =>
310 -- By reference types are passed by reference (RM 6.2(4))
312 if Is_By_Reference_Type (Typ) then
313 Set_Mechanism (Formal, By_Reference);
315 -- By copy types are passed by copy (RM 6.2(3))
317 elsif Is_By_Copy_Type (Typ) then
318 Set_Mechanism (Formal, By_Copy);
320 -- All other types we leave the Default_Mechanism set, so
321 -- that the backend can choose the appropriate method.
327 -- Special Ada conventions specifying passing mechanism
329 when Convention_Ada_Pass_By_Copy =>
330 Set_Mechanism (Formal, By_Copy);
332 when Convention_Ada_Pass_By_Reference =>
333 Set_Mechanism (Formal, By_Reference);
339 -- Note: Assembler, C++, Java, Stdcall also use C conventions
341 when Convention_Assembler |
346 Convention_Stdcall =>
348 -- The following values are passed by copy
350 -- IN Scalar parameters (RM B.3(66))
351 -- IN parameters of access types (RM B.3(67))
352 -- Access parameters (RM B.3(68))
353 -- Access to subprogram types (RM B.3(71))
355 -- Note: in the case of access parameters, it is the
356 -- pointer that is passed by value. In GNAT access
357 -- parameters are treated as IN parameters of an
358 -- anonymous access type, so this falls out free.
360 -- The bottom line is that all IN elementary types
361 -- are passed by copy in GNAT.
363 if Is_Elementary_Type (Typ) then
364 if Ekind (Formal) = E_In_Parameter then
365 Set_Mechanism (Formal, By_Copy);
367 -- OUT and IN OUT parameters of elementary types are
368 -- passed by reference (RM B.3(68)). Note that we are
369 -- not following the advice to pass the address of a
370 -- copy to preserve by copy semantics.
373 Set_Mechanism (Formal, By_Reference);
376 -- Records are normally passed by reference (RM B.3(69)).
377 -- However, this can be overridden by the use of the
378 -- C_Pass_By_Copy pragma or C_Pass_By_Copy convention.
380 elsif Is_Record_Type (Typ) then
382 -- If the record is not convention C, then we always
383 -- pass by reference, C_Pass_By_Copy does not apply.
385 if Convention (Typ) /= Convention_C then
386 Set_Mechanism (Formal, By_Reference);
388 -- If convention C_Pass_By_Copy was specified for
389 -- the record type, then we pass by copy.
391 elsif C_Pass_By_Copy (Typ) then
392 Set_Mechanism (Formal, By_Copy);
394 -- Otherwise, for a C convention record, we set the
395 -- convention in accordance with a possible use of
396 -- the C_Pass_By_Copy pragma. Note that the value of
397 -- Default_C_Record_Mechanism in the absence of such
398 -- a pragma is By_Reference.
401 Set_Mechanism (Formal, Default_C_Record_Mechanism);
404 -- Array types are passed by reference (B.3 (71))
406 elsif Is_Array_Type (Typ) then
407 Set_Mechanism (Formal, By_Reference);
409 -- For all other types, use Default_Mechanism mechanism
419 when Convention_COBOL =>
421 -- Access parameters (which in GNAT look like IN parameters
422 -- of an access type) are passed by copy (RM B.4(96)) as
423 -- are all other IN parameters of scalar type (RM B.4(97)).
425 -- For now we pass these parameters by reference as well.
426 -- The RM specifies the intent BY_CONTENT, but gigi does
427 -- not currently transform By_Copy properly. If we pass by
428 -- reference, it will be imperative to introduce copies ???
430 if Is_Elementary_Type (Typ)
431 and then Ekind (Formal) = E_In_Parameter
433 Set_Mechanism (Formal, By_Reference);
435 -- All other parameters (i.e. all non-scalar types, and
436 -- all OUT or IN OUT parameters) are passed by reference.
437 -- Note that at the moment we are not bothering to make
438 -- copies of scalar types as recommended in the RM.
441 Set_Mechanism (Formal, By_Reference);
448 when Convention_Fortran =>
450 -- In OpenVMS, pass a character of array of character
451 -- value using Descriptor(S).
454 and then (Root_Type (Typ) = Standard_Character
458 Root_Type (Component_Type (Typ)) =
461 Set_Mechanism (Formal, By_Descriptor_S);
463 -- Access types are passed by default (presumably this
464 -- will mean they are passed by copy)
466 elsif Is_Access_Type (Typ) then
469 -- For now, we pass all other parameters by reference.
470 -- It is not clear that this is right in the long run,
471 -- but it seems to correspond to what gnu f77 wants.
474 Set_Mechanism (Formal, By_Reference);
480 <<Skip_Formal>> -- remove this when problem above is fixed ???
482 Next_Formal (Formal);
485 -- Note: there is nothing we need to do for the return type here.
486 -- We deal with returning by reference in the Ada sense, by use of
487 -- the flag By_Ref, rather than by messing with mechanisms.
489 -- A mechanism of Reference for the return means that an extra
490 -- parameter must be provided for the return value (that is the
491 -- DEC meaning of the pragma), and is unrelated to the Ada notion
492 -- of return by reference.
494 -- Note: there was originally code here to set the mechanism to
495 -- By_Reference for types that are "by reference" in the Ada sense,
496 -- but, in accordance with the discussion above, this is wrong, and
497 -- the code was removed.