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-2019, 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 26with Atree; use Atree; 27with Einfo; use Einfo; 28with Errout; use Errout; 29with Namet; use Namet; 30with Sem; use Sem; 31with Sem_Aux; use Sem_Aux; 32with Sinfo; use Sinfo; 33with Snames; use Snames; 34 35package 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_Entry 151 | Convention_Intrinsic 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 341end Sem_Mech; 342