-- --
-- B o d y --
-- --
--- Copyright (C) 1996-2013, Free Software Foundation, Inc. --
+-- Copyright (C) 1996-2021, 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- --
-- --
------------------------------------------------------------------------------
-with Atree; use Atree;
-with Einfo; use Einfo;
-with Errout; use Errout;
-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;
+with Atree; use Atree;
+with Einfo; use Einfo;
+with Einfo.Entities; use Einfo.Entities;
+with Einfo.Utils; use Einfo.Utils;
+with Errout; use Errout;
+with Namet; use Namet;
+with Sem; use Sem;
+with Sem_Aux; use Sem_Aux;
+with Sinfo; use Sinfo;
+with Sinfo.Nodes; use Sinfo.Nodes;
+with Snames; use Snames;
package body Sem_Mech is
-------------------------
procedure Set_Mechanism_Value (Ent : Entity_Id; Mech_Name : Node_Id) is
- Class : Node_Id;
- Param : Node_Id;
-
- procedure Bad_Class;
- -- Signal bad descriptor class name
procedure Bad_Mechanism;
-- Signal bad mechanism name
- procedure Bad_Class is
- begin
- Error_Msg_N ("unrecognized descriptor class name", Class);
- end Bad_Class;
+ -------------------
+ -- Bad_Mechanism --
+ -------------------
procedure Bad_Mechanism is
begin
("mechanism for & has already been set", Mech_Name, Ent);
end if;
- -- MECHANISM_NAME ::= value | reference | descriptor | short_descriptor
+ -- MECHANISM_NAME ::= value | reference
if Nkind (Mech_Name) = N_Identifier then
if Chars (Mech_Name) = Name_Value then
Set_Mechanism_With_Checks (Ent, By_Copy, Mech_Name);
- return;
elsif Chars (Mech_Name) = Name_Reference then
Set_Mechanism_With_Checks (Ent, By_Reference, Mech_Name);
- return;
-
- elsif Chars (Mech_Name) = Name_Descriptor then
- Check_VMS (Mech_Name);
- 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);
else
Bad_Mechanism;
- return;
- end if;
-
- -- 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
-
- elsif Nkind (Mech_Name) = N_Indexed_Component then
- Class := First (Expressions (Mech_Name));
-
- if Nkind (Prefix (Mech_Name)) /= N_Identifier
- or else
- not Nam_In (Chars (Prefix (Mech_Name)), Name_Descriptor,
- Name_Short_Descriptor)
- or else Present (Next (Class))
- then
- Bad_Mechanism;
- return;
- end if;
-
- -- 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
-
- elsif Nkind (Mech_Name) = N_Function_Call then
-
- Param := First (Parameter_Associations (Mech_Name));
-
- if Nkind (Name (Mech_Name)) /= N_Identifier
- or else
- not Nam_In (Chars (Name (Mech_Name)), Name_Descriptor,
- Name_Short_Descriptor)
- or else Present (Next (Param))
- or else No (Selector_Name (Param))
- or else Chars (Selector_Name (Param)) /= Name_Class
- then
- Bad_Mechanism;
- return;
- else
- Class := Explicit_Actual_Parameter (Param);
end if;
else
Bad_Mechanism;
- return;
- end if;
-
- -- Fall through here with Class set to descriptor class name
-
- Check_VMS (Mech_Name);
-
- if Nkind (Class) /= N_Identifier then
- Bad_Class;
- return;
-
- 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 (Name (Mech_Name)) = Name_Descriptor
- and then Chars (Class) = Name_UBSB
- then
- Set_Mechanism_With_Checks (Ent, By_Descriptor_UBSB, Mech_Name);
-
- 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 (Name (Mech_Name)) = Name_Descriptor
- and then Chars (Class) = Name_S
- then
- Set_Mechanism_With_Checks (Ent, By_Descriptor_S, Mech_Name);
-
- 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 (Name (Mech_Name)) = Name_Descriptor
- and then Chars (Class) = Name_A
- then
- Set_Mechanism_With_Checks (Ent, By_Descriptor_A, Mech_Name);
-
- 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;
Mech : Mechanism_Type;
Enod : Node_Id)
is
- begin
- -- Right now we only do some checks for functions returning arguments
- -- by descriptor. Probably mode checks need to be added here ???
+ pragma Unreferenced (Enod);
- if Mech in Descriptor_Codes and then not Is_Formal (Ent) then
- if Is_Record_Type (Etype (Ent)) then
- Error_Msg_N ("??records cannot be returned by Descriptor", Enod);
- return;
- end if;
- end if;
-
- -- If we fall through, all checks have passed
+ begin
+ -- Right now we don't do any checks, should we do more ???
Set_Mechanism (Ent, Mech);
end Set_Mechanism_With_Checks;
-- Ada --
---------
- -- Note: all RM defined conventions are treated the same
- -- from the point of view of parameter passing mechanism
-
- when Convention_Ada |
- Convention_Intrinsic |
- Convention_Entry |
- Convention_Protected |
- Convention_Stubbed =>
+ -- Note: all RM defined conventions are treated the same from
+ -- the point of view of parameter passing mechanism. Convention
+ -- Ghost has the same dynamic semantics as convention Ada.
+ when Convention_Ada
+ | Convention_Entry
+ | Convention_Intrinsic
+ | Convention_Protected
+ | Convention_Stubbed
+ =>
-- By reference types are passed by reference (RM 6.2(4))
if Is_By_Reference_Type (Typ) then
-- C --
-------
- -- Note: Assembler, C++, Java, Stdcall also use C conventions
-
- when Convention_Assembler |
- Convention_C |
- Convention_CIL |
- Convention_CPP |
- Convention_Java |
- Convention_Stdcall =>
+ -- Note: Assembler and Stdcall also use C conventions
+ when Convention_Assembler
+ | Convention_C_Family
+ | Convention_Stdcall
+ =>
-- The following values are passed by copy
-- IN Scalar parameters (RM B.3(66))
-- OUT and IN OUT parameters of record types are passed
-- by reference regardless of pragmas (RM B.3 (69/2)).
- elsif Ekind_In (Formal, E_Out_Parameter,
- E_In_Out_Parameter)
+ elsif Ekind (Formal) in
+ E_Out_Parameter | E_In_Out_Parameter
then
Set_Mechanism (Formal, By_Reference);
when Convention_Fortran =>
- -- In OpenVMS, pass a character of array of character
- -- value using Descriptor(S).
-
- if OpenVMS_On_Target
- and then (Root_Type (Typ) = Standard_Character
- or else
- (Is_Array_Type (Typ)
- and then
- Root_Type (Component_Type (Typ)) =
- Standard_Character))
- then
- Set_Mechanism (Formal, By_Descriptor_S);
-
-- Access types are passed by default (presumably this
-- will mean they are passed by copy)
- elsif Is_Access_Type (Typ) then
+ if Is_Access_Type (Typ) then
null;
-- For now, we pass all other parameters by reference.
else
Set_Mechanism (Formal, By_Reference);
end if;
-
end case;
end if;
git://gcc.gnu.org / gcc.git / blobdiff