1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1996-2007, 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_Util
; use Sem_Util
;
33 with Sinfo
; use Sinfo
;
34 with Snames
; use Snames
;
35 with Stand
; use Stand
;
36 with Targparm
; use Targparm
;
38 package body Sem_Mech
is
40 -------------------------
41 -- Set_Mechanism_Value --
42 -------------------------
44 procedure Set_Mechanism_Value
(Ent
: Entity_Id
; Mech_Name
: Node_Id
) is
49 -- Signal bad descriptor class name
51 procedure Bad_Mechanism
;
52 -- Signal bad mechanism name
54 procedure Bad_Class
is
56 Error_Msg_N
("unrecognized descriptor class name", Class
);
59 procedure Bad_Mechanism
is
61 Error_Msg_N
("unrecognized mechanism name", Mech_Name
);
64 -- Start of processing for Set_Mechanism_Value
67 if Mechanism
(Ent
) /= Default_Mechanism
then
69 ("mechanism for & has already been set", Mech_Name
, Ent
);
72 -- MECHANISM_NAME ::= value | reference | descriptor
74 if Nkind
(Mech_Name
) = N_Identifier
then
75 if Chars
(Mech_Name
) = Name_Value
then
76 Set_Mechanism_With_Checks
(Ent
, By_Copy
, Mech_Name
);
79 elsif Chars
(Mech_Name
) = Name_Reference
then
80 Set_Mechanism_With_Checks
(Ent
, By_Reference
, Mech_Name
);
83 elsif Chars
(Mech_Name
) = Name_Descriptor
then
84 Check_VMS
(Mech_Name
);
85 Set_Mechanism_With_Checks
(Ent
, By_Descriptor
, Mech_Name
);
88 elsif Chars
(Mech_Name
) = Name_Copy
then
90 ("bad mechanism name, Value assumed", Mech_Name
);
91 Set_Mechanism
(Ent
, By_Copy
);
98 -- MECHANISM_NAME ::= descriptor (CLASS_NAME)
99 -- CLASS_NAME ::= ubs | ubsb | uba | s | sb | a | nca
101 -- Note: this form is parsed as an indexed component
103 elsif Nkind
(Mech_Name
) = N_Indexed_Component
then
104 Class
:= First
(Expressions
(Mech_Name
));
106 if Nkind
(Prefix
(Mech_Name
)) /= N_Identifier
107 or else Chars
(Prefix
(Mech_Name
)) /= Name_Descriptor
108 or else Present
(Next
(Class
))
114 -- MECHANISM_NAME ::= descriptor (Class => CLASS_NAME)
115 -- CLASS_NAME ::= ubs | ubsb | uba | s | sb | a | nca
117 -- Note: this form is parsed as a function call
119 elsif Nkind
(Mech_Name
) = N_Function_Call
then
121 Param
:= First
(Parameter_Associations
(Mech_Name
));
123 if Nkind
(Name
(Mech_Name
)) /= N_Identifier
124 or else Chars
(Name
(Mech_Name
)) /= Name_Descriptor
125 or else Present
(Next
(Param
))
126 or else No
(Selector_Name
(Param
))
127 or else Chars
(Selector_Name
(Param
)) /= Name_Class
132 Class
:= Explicit_Actual_Parameter
(Param
);
140 -- Fall through here with Class set to descriptor class name
142 Check_VMS
(Mech_Name
);
144 if Nkind
(Class
) /= N_Identifier
then
148 elsif Chars
(Class
) = Name_UBS
then
149 Set_Mechanism_With_Checks
(Ent
, By_Descriptor_UBS
, Mech_Name
);
151 elsif Chars
(Class
) = Name_UBSB
then
152 Set_Mechanism_With_Checks
(Ent
, By_Descriptor_UBSB
, Mech_Name
);
154 elsif Chars
(Class
) = Name_UBA
then
155 Set_Mechanism_With_Checks
(Ent
, By_Descriptor_UBA
, Mech_Name
);
157 elsif Chars
(Class
) = Name_S
then
158 Set_Mechanism_With_Checks
(Ent
, By_Descriptor_S
, Mech_Name
);
160 elsif Chars
(Class
) = Name_SB
then
161 Set_Mechanism_With_Checks
(Ent
, By_Descriptor_SB
, Mech_Name
);
163 elsif Chars
(Class
) = Name_A
then
164 Set_Mechanism_With_Checks
(Ent
, By_Descriptor_A
, Mech_Name
);
166 elsif Chars
(Class
) = Name_NCA
then
167 Set_Mechanism_With_Checks
(Ent
, By_Descriptor_NCA
, Mech_Name
);
173 end Set_Mechanism_Value
;
175 -------------------------------
176 -- Set_Mechanism_With_Checks --
177 -------------------------------
179 procedure Set_Mechanism_With_Checks
181 Mech
: Mechanism_Type
;
185 -- Right now we only do some checks for functions returning arguments
186 -- by desctiptor. Probably mode checks need to be added here ???
188 if Mech
in Descriptor_Codes
and then not Is_Formal
(Ent
) then
189 if Is_Record_Type
(Etype
(Ent
)) then
190 Error_Msg_N
("?records cannot be returned by Descriptor", Enod
);
195 -- If we fall through, all checks have passed
197 Set_Mechanism
(Ent
, Mech
);
198 end Set_Mechanism_With_Checks
;
204 procedure Set_Mechanisms
(E
: Entity_Id
) is
209 -- Skip this processing if inside a generic template. Not only is
210 -- it uneccessary (since neither extra formals nor mechanisms are
211 -- relevant for the template itself), but at least at the moment,
212 -- procedures get frozen early inside a template so attempting to
213 -- look at the formal types does not work too well if they are
214 -- private types that have not been frozen yet.
216 if Inside_A_Generic
then
220 -- Loop through formals
222 Formal
:= First_Formal
(E
);
223 while Present
(Formal
) loop
225 if Mechanism
(Formal
) = Default_Mechanism
then
226 Typ
:= Underlying_Type
(Etype
(Formal
));
228 -- If there is no underlying type, then skip this processing and
229 -- leave the convention set to Default_Mechanism. It seems odd
230 -- that there should ever be such cases but there are (see
231 -- comments for filed regression tests 1418-001 and 1912-009) ???
237 case Convention
(E
) is
243 -- Note: all RM defined conventions are treated the same
244 -- from the point of view of parameter passing mechanims
246 when Convention_Ada |
247 Convention_Intrinsic |
249 Convention_Protected |
250 Convention_Stubbed
=>
252 -- By reference types are passed by reference (RM 6.2(4))
254 if Is_By_Reference_Type
(Typ
) then
255 Set_Mechanism
(Formal
, By_Reference
);
257 -- By copy types are passed by copy (RM 6.2(3))
259 elsif Is_By_Copy_Type
(Typ
) then
260 Set_Mechanism
(Formal
, By_Copy
);
262 -- All other types we leave the Default_Mechanism set, so
263 -- that the backend can choose the appropriate method.
273 -- Note: Assembler, C++, Java, Stdcall also use C conventions
275 when Convention_Assembler |
280 Convention_Stdcall
=>
282 -- The following values are passed by copy
284 -- IN Scalar parameters (RM B.3(66))
285 -- IN parameters of access types (RM B.3(67))
286 -- Access parameters (RM B.3(68))
287 -- Access to subprogram types (RM B.3(71))
289 -- Note: in the case of access parameters, it is the
290 -- pointer that is passed by value. In GNAT access
291 -- parameters are treated as IN parameters of an
292 -- anonymous access type, so this falls out free.
294 -- The bottom line is that all IN elementary types
295 -- are passed by copy in GNAT.
297 if Is_Elementary_Type
(Typ
) then
298 if Ekind
(Formal
) = E_In_Parameter
then
299 Set_Mechanism
(Formal
, By_Copy
);
301 -- OUT and IN OUT parameters of elementary types are
302 -- passed by reference (RM B.3(68)). Note that we are
303 -- not following the advice to pass the address of a
304 -- copy to preserve by copy semantics.
307 Set_Mechanism
(Formal
, By_Reference
);
310 -- Records are normally passed by reference (RM B.3(69)).
311 -- However, this can be overridden by the use of the
312 -- C_Pass_By_Copy pragma or C_Pass_By_Copy convention.
314 elsif Is_Record_Type
(Typ
) then
316 -- If the record is not convention C, then we always
317 -- pass by reference, C_Pass_By_Copy does not apply.
319 if Convention
(Typ
) /= Convention_C
then
320 Set_Mechanism
(Formal
, By_Reference
);
322 -- If convention C_Pass_By_Copy was specified for
323 -- the record type, then we pass by copy.
325 elsif C_Pass_By_Copy
(Typ
) then
326 Set_Mechanism
(Formal
, By_Copy
);
328 -- Otherwise, for a C convention record, we set the
329 -- convention in accordance with a possible use of
330 -- the C_Pass_By_Copy pragma. Note that the value of
331 -- Default_C_Record_Mechanism in the absence of such
332 -- a pragma is By_Reference.
335 Set_Mechanism
(Formal
, Default_C_Record_Mechanism
);
338 -- Array types are passed by reference (B.3 (71))
340 elsif Is_Array_Type
(Typ
) then
341 Set_Mechanism
(Formal
, By_Reference
);
343 -- For all other types, use Default_Mechanism mechanism
353 when Convention_COBOL
=>
355 -- Access parameters (which in GNAT look like IN parameters
356 -- of an access type) are passed by copy (RM B.4(96)) as
357 -- are all other IN parameters of scalar type (RM B.4(97)).
359 -- For now we pass these parameters by reference as well.
360 -- The RM specifies the intent BY_CONTENT, but gigi does
361 -- not currently transform By_Copy properly. If we pass by
362 -- reference, it will be imperative to introduce copies ???
364 if Is_Elementary_Type
(Typ
)
365 and then Ekind
(Formal
) = E_In_Parameter
367 Set_Mechanism
(Formal
, By_Reference
);
369 -- All other parameters (i.e. all non-scalar types, and
370 -- all OUT or IN OUT parameters) are passed by reference.
371 -- Note that at the moment we are not bothering to make
372 -- copies of scalar types as recommended in the RM.
375 Set_Mechanism
(Formal
, By_Reference
);
382 when Convention_Fortran
=>
384 -- In OpenVMS, pass a character of array of character
385 -- value using Descriptor(S).
388 and then (Root_Type
(Typ
) = Standard_Character
392 Root_Type
(Component_Type
(Typ
)) =
395 Set_Mechanism
(Formal
, By_Descriptor_S
);
397 -- Access types are passed by default (presumably this
398 -- will mean they are passed by copy)
400 elsif Is_Access_Type
(Typ
) then
403 -- For now, we pass all other parameters by reference.
404 -- It is not clear that this is right in the long run,
405 -- but it seems to correspond to what gnu f77 wants.
408 Set_Mechanism
(Formal
, By_Reference
);
414 <<Skip_Formal
>> -- remove this when problem above is fixed ???
416 Next_Formal
(Formal
);
419 -- Note: there is nothing we need to do for the return type here.
420 -- We deal with returning by reference in the Ada sense, by use of
421 -- the flag By_Ref, rather than by messing with mechanisms.
423 -- A mechanism of Reference for the return means that an extra
424 -- parameter must be provided for the return value (that is the
425 -- DEC meaning of the pragma), and is unrelated to the Ada notion
426 -- of return by reference.
428 -- Note: there was originally code here to set the mechanism to
429 -- By_Reference for types that are "by reference" in the Ada sense,
430 -- but, in accordance with the discussion above, this is wrong, and
431 -- the code was removed.