-- --
-- B o d y --
-- --
--- --
--- Copyright (C) 1996-2002 Free Software Foundation, Inc. --
+-- Copyright (C) 1996-2008, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
--- ware Foundation; either version 2, or (at your option) any later ver- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
-- for more details. You should have received a copy of the GNU General --
--- Public License distributed with GNAT; see file COPYING. If not, write --
--- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
--- MA 02111-1307, USA. --
+-- Public License distributed with GNAT; see file COPYING3. If not, go to --
+-- http://www.gnu.org/licenses for a complete copy of the license. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
--- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
with Atree; use Atree;
with Einfo; use Einfo;
with Errout; use Errout;
-with Targparm; use Targparm;
+with Namet; use Namet;
with Nlists; use Nlists;
with Sem; use Sem;
+with Sem_Aux; use Sem_Aux;
with Sem_Util; use Sem_Util;
with Sinfo; use Sinfo;
with Snames; use Snames;
with Stand; use Stand;
+with Targparm; use Targparm;
package body Sem_Mech is
("mechanism for & has already been set", Mech_Name, Ent);
end if;
- -- MECHANISM_NAME ::= value | reference | descriptor
+ -- MECHANISM_NAME ::= value | reference | descriptor | short_descriptor
if Nkind (Mech_Name) = N_Identifier then
if Chars (Mech_Name) = Name_Value then
Set_Mechanism_With_Checks (Ent, By_Descriptor, Mech_Name);
return;
+ elsif Chars (Mech_Name) = Name_Short_Descriptor then
+ Check_VMS (Mech_Name);
+ Set_Mechanism_With_Checks (Ent, By_Short_Descriptor, Mech_Name);
+ return;
+
elsif Chars (Mech_Name) = Name_Copy then
Error_Msg_N
("bad mechanism name, Value assumed", Mech_Name);
return;
end if;
- -- MECHANISM_NAME ::= descriptor (CLASS_NAME)
+ -- MECHANISM_NAME ::= descriptor (CLASS_NAME) |
+ -- short_descriptor (CLASS_NAME)
-- CLASS_NAME ::= ubs | ubsb | uba | s | sb | a | nca
-- Note: this form is parsed as an indexed component
Class := First (Expressions (Mech_Name));
if Nkind (Prefix (Mech_Name)) /= N_Identifier
- or else Chars (Prefix (Mech_Name)) /= Name_Descriptor
+ or else not (Chars (Prefix (Mech_Name)) = Name_Descriptor or else
+ Chars (Prefix (Mech_Name)) = Name_Short_Descriptor)
or else Present (Next (Class))
then
Bad_Mechanism;
return;
end if;
- -- MECHANISM_NAME ::= descriptor (Class => CLASS_NAME)
+ -- MECHANISM_NAME ::= descriptor (Class => CLASS_NAME) |
+ -- short_descriptor (Class => CLASS_NAME)
-- CLASS_NAME ::= ubs | ubsb | uba | s | sb | a | nca
-- Note: this form is parsed as a function call
Param := First (Parameter_Associations (Mech_Name));
if Nkind (Name (Mech_Name)) /= N_Identifier
- or else Chars (Name (Mech_Name)) /= Name_Descriptor
+ or else not (Chars (Name (Mech_Name)) = Name_Descriptor or else
+ Chars (Name (Mech_Name)) = Name_Short_Descriptor)
or else Present (Next (Param))
or else No (Selector_Name (Param))
or else Chars (Selector_Name (Param)) /= Name_Class
Bad_Class;
return;
- elsif Chars (Class) = Name_UBS then
+ elsif Chars (Name (Mech_Name)) = Name_Descriptor
+ and then Chars (Class) = Name_UBS
+ then
Set_Mechanism_With_Checks (Ent, By_Descriptor_UBS, Mech_Name);
- elsif Chars (Class) = Name_UBSB then
+ elsif Chars (Name (Mech_Name)) = Name_Descriptor
+ and then Chars (Class) = Name_UBSB
+ then
Set_Mechanism_With_Checks (Ent, By_Descriptor_UBSB, Mech_Name);
- elsif Chars (Class) = Name_UBA then
+ elsif Chars (Name (Mech_Name)) = Name_Descriptor
+ and then Chars (Class) = Name_UBA
+ then
Set_Mechanism_With_Checks (Ent, By_Descriptor_UBA, Mech_Name);
- elsif Chars (Class) = Name_S then
+ elsif Chars (Name (Mech_Name)) = Name_Descriptor
+ and then Chars (Class) = Name_S
+ then
Set_Mechanism_With_Checks (Ent, By_Descriptor_S, Mech_Name);
- elsif Chars (Class) = Name_SB then
+ elsif Chars (Name (Mech_Name)) = Name_Descriptor
+ and then Chars (Class) = Name_SB
+ then
Set_Mechanism_With_Checks (Ent, By_Descriptor_SB, Mech_Name);
- elsif Chars (Class) = Name_A then
+ elsif Chars (Name (Mech_Name)) = Name_Descriptor
+ and then Chars (Class) = Name_A
+ then
Set_Mechanism_With_Checks (Ent, By_Descriptor_A, Mech_Name);
- elsif Chars (Class) = Name_NCA then
+ elsif Chars (Name (Mech_Name)) = Name_Descriptor
+ and then Chars (Class) = Name_NCA
+ then
Set_Mechanism_With_Checks (Ent, By_Descriptor_NCA, Mech_Name);
+ elsif Chars (Name (Mech_Name)) = Name_Short_Descriptor
+ and then Chars (Class) = Name_UBS
+ then
+ Set_Mechanism_With_Checks (Ent, By_Short_Descriptor_UBS, Mech_Name);
+
+ elsif Chars (Name (Mech_Name)) = Name_Short_Descriptor
+ and then Chars (Class) = Name_UBSB
+ then
+ Set_Mechanism_With_Checks (Ent, By_Short_Descriptor_UBSB, Mech_Name);
+
+ elsif Chars (Name (Mech_Name)) = Name_Short_Descriptor
+ and then Chars (Class) = Name_UBA
+ then
+ Set_Mechanism_With_Checks (Ent, By_Short_Descriptor_UBA, Mech_Name);
+
+ elsif Chars (Name (Mech_Name)) = Name_Short_Descriptor
+ and then Chars (Class) = Name_S
+ then
+ Set_Mechanism_With_Checks (Ent, By_Short_Descriptor_S, Mech_Name);
+
+ elsif Chars (Name (Mech_Name)) = Name_Short_Descriptor
+ and then Chars (Class) = Name_SB
+ then
+ Set_Mechanism_With_Checks (Ent, By_Short_Descriptor_SB, Mech_Name);
+
+ elsif Chars (Name (Mech_Name)) = Name_Short_Descriptor
+ and then Chars (Class) = Name_A
+ then
+ Set_Mechanism_With_Checks (Ent, By_Short_Descriptor_A, Mech_Name);
+
+ elsif Chars (Name (Mech_Name)) = Name_Short_Descriptor
+ and then Chars (Class) = Name_NCA
+ then
+ Set_Mechanism_With_Checks (Ent, By_Short_Descriptor_NCA, Mech_Name);
+
else
Bad_Class;
return;
end if;
-
end Set_Mechanism_Value;
-------------------------------
is
begin
-- Right now we only do some checks for functions returning arguments
- -- by desctiptor. Probably mode checks need to be added here ???
+ -- by descriptor. Probably mode checks need to be added here ???
if Mech in Descriptor_Codes and then not Is_Formal (Ent) then
if Is_Record_Type (Etype (Ent)) then
begin
-- Skip this processing if inside a generic template. Not only is
- -- it uneccessary (since neither extra formals nor mechanisms are
+ -- it unnecessary (since neither extra formals nor mechanisms are
-- relevant for the template itself), but at least at the moment,
-- procedures get frozen early inside a template so attempting to
-- look at the formal types does not work too well if they are
---------
-- Note: all RM defined conventions are treated the same
- -- from the point of view of parameter passing mechanims
+ -- from the point of view of parameter passing mechanism
when Convention_Ada |
Convention_Intrinsic |
when Convention_Assembler |
Convention_C |
+ Convention_CIL |
Convention_CPP |
Convention_Java |
Convention_Stdcall =>
Next_Formal (Formal);
end loop;
- -- Now deal with return type, we always leave the default mechanism
- -- set except for the case of returning a By_Reference type for an
- -- Ada convention, where we force return by reference
+ -- Note: there is nothing we need to do for the return type here.
+ -- We deal with returning by reference in the Ada sense, by use of
+ -- the flag By_Ref, rather than by messing with mechanisms.
- if Ekind (E) = E_Function
- and then Mechanism (E) = Default_Mechanism
- and then not Has_Foreign_Convention (E)
- and then Is_By_Reference_Type (Etype (E))
- then
- Set_Mechanism (E, By_Reference);
- end if;
+ -- A mechanism of Reference for the return means that an extra
+ -- parameter must be provided for the return value (that is the
+ -- DEC meaning of the pragma), and is unrelated to the Ada notion
+ -- of return by reference.
+
+ -- Note: there was originally code here to set the mechanism to
+ -- By_Reference for types that are "by reference" in the Ada sense,
+ -- but, in accordance with the discussion above, this is wrong, and
+ -- the code was removed.
end Set_Mechanisms;