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