First steps in implementation of convention Ada_Pass_By_Copy/Reference
Not yet complete, not ready for tests.
Tested on x86_64-pc-linux-gnu, committed on trunk
2011-08-03 Robert Dewar <de...@adacore.com>
* repinfo.adb (List_Mechanism): Add handling of
Convention_Ada_Pass_By_XXX.
* sem_mech.adb (Set_Mechanism): Ditto.
* sem_prag.adb (Process_Convention): Add entries for
Convention_Ada_Pass_By_XXX.
* snames.adb-tmpl, snames.ads-tmpl: Ditto.
Index: sem_prag.adb
===================================================================
--- sem_prag.adb (revision 177239)
+++ sem_prag.adb (working copy)
@@ -3014,6 +3014,38 @@
Ent := E;
+ -- Ada_Pass_By_Copy special checking
+
+ if C = Convention_Ada_Pass_By_Copy then
+ if not Is_First_Subtype (E) then
+ Error_Pragma_Arg
+ ("convention `Ada_Pass_By_Copy` only "
+ & "allowed for types", Arg2);
+ end if;
+
+ if Is_By_Reference_Type (E) then
+ Error_Pragma_Arg
+ ("convention `Ada_Pass_By_Copy` not allowed for "
+ & "by-reference type", Arg1);
+ end if;
+ end if;
+
+ -- Ada_Pass_By_Reference special checking
+
+ if C = Convention_Ada_Pass_By_Reference then
+ if not Is_First_Subtype (E) then
+ Error_Pragma_Arg
+ ("convention `Ada_Pass_By_Reference` only "
+ & "allowed for types", Arg2);
+ end if;
+
+ if Is_By_Copy_Type (E) then
+ Error_Pragma_Arg
+ ("convention `Ada_Pass_By_Reference` not allowed for "
+ & "by-copy type", Arg1);
+ end if;
+ end if;
+
-- Go to renamed subprogram if present, since convention applies to
-- the actual renamed entity, not to the renaming entity. If the
-- subprogram is inherited, go to parent subprogram.
Index: repinfo.adb
===================================================================
--- repinfo.adb (revision 176998)
+++ repinfo.adb (working copy)
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 1999-2010, Free Software Foundation, Inc. --
+-- Copyright (C) 1999-2011, 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- --
@@ -665,19 +665,36 @@
Write_Str (" convention : ");
case Convention (Ent) is
- when Convention_Ada => Write_Line ("Ada");
- when Convention_Intrinsic => Write_Line ("InLineinsic");
- when Convention_Entry => Write_Line ("Entry");
- when Convention_Protected => Write_Line ("Protected");
- when Convention_Assembler => Write_Line ("Assembler");
- when Convention_C => Write_Line ("C");
- when Convention_CIL => Write_Line ("CIL");
- when Convention_COBOL => Write_Line ("COBOL");
- when Convention_CPP => Write_Line ("C++");
- when Convention_Fortran => Write_Line ("Fortran");
- when Convention_Java => Write_Line ("Java");
- when Convention_Stdcall => Write_Line ("Stdcall");
- when Convention_Stubbed => Write_Line ("Stubbed");
+ when Convention_Ada =>
+ Write_Line ("Ada");
+ when Convention_Ada_Pass_By_Copy =>
+ Write_Line ("Ada_Pass_By_Copy");
+ when Convention_Ada_Pass_By_Reference =>
+ Write_Line ("Ada_Pass_By_Reference");
+ when Convention_Intrinsic =>
+ Write_Line ("Intrinsic");
+ when Convention_Entry =>
+ Write_Line ("Entry");
+ when Convention_Protected =>
+ Write_Line ("Protected");
+ when Convention_Assembler =>
+ Write_Line ("Assembler");
+ when Convention_C =>
+ Write_Line ("C");
+ when Convention_CIL =>
+ Write_Line ("CIL");
+ when Convention_COBOL =>
+ Write_Line ("COBOL");
+ when Convention_CPP =>
+ Write_Line ("C++");
+ when Convention_Fortran =>
+ Write_Line ("Fortran");
+ when Convention_Java =>
+ Write_Line ("Java");
+ when Convention_Stdcall =>
+ Write_Line ("Stdcall");
+ when Convention_Stubbed =>
+ Write_Line ("Stubbed");
end case;
-- Find max length of formal name
Index: sem_mech.adb
===================================================================
--- sem_mech.adb (revision 176998)
+++ sem_mech.adb (working copy)
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 1996-2010, Free Software Foundation, Inc. --
+-- Copyright (C) 1996-2011, 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- --
@@ -324,6 +324,14 @@
null;
end if;
+ -- Special Ada conventions specifying passing mechanism
+
+ when Convention_Ada_Pass_By_Copy =>
+ Set_Mechanism (Formal, By_Copy);
+
+ when Convention_Ada_Pass_By_Reference =>
+ Set_Mechanism (Formal, By_Reference);
+
-------
-- C --
-------
Index: snames.adb-tmpl
===================================================================
--- snames.adb-tmpl (revision 176998)
+++ snames.adb-tmpl (working copy)
@@ -137,22 +137,25 @@
function Get_Convention_Id (N : Name_Id) return Convention_Id is
begin
case N is
- when Name_Ada => return Convention_Ada;
- when Name_Assembler => return Convention_Assembler;
- when Name_C => return Convention_C;
- when Name_CIL => return Convention_CIL;
- when Name_COBOL => return Convention_COBOL;
- when Name_CPP => return Convention_CPP;
- when Name_Fortran => return Convention_Fortran;
- when Name_Intrinsic => return Convention_Intrinsic;
- when Name_Java => return Convention_Java;
- when Name_Stdcall => return Convention_Stdcall;
- when Name_Stubbed => return Convention_Stubbed;
+ when Name_Ada => return Convention_Ada;
+ when Name_Ada_Pass_By_Copy => return Convention_Ada_Pass_By_Copy;
+ when Name_Ada_Pass_By_Reference =>
+ return Convention_Ada_Pass_By_Reference;
+ when Name_Assembler => return Convention_Assembler;
+ when Name_C => return Convention_C;
+ when Name_CIL => return Convention_CIL;
+ when Name_COBOL => return Convention_COBOL;
+ when Name_CPP => return Convention_CPP;
+ when Name_Fortran => return Convention_Fortran;
+ when Name_Intrinsic => return Convention_Intrinsic;
+ when Name_Java => return Convention_Java;
+ when Name_Stdcall => return Convention_Stdcall;
+ when Name_Stubbed => return Convention_Stubbed;
-- If no direct match, then we must have a convention
-- identifier pragma that has specified this name.
- when others =>
+ when others =>
for J in 1 .. Convention_Identifiers.Last loop
if N = Convention_Identifiers.Table (J).Name then
return Convention_Identifiers.Table (J).Convention;
@@ -170,19 +173,22 @@
function Get_Convention_Name (C : Convention_Id) return Name_Id is
begin
case C is
- when Convention_Ada => return Name_Ada;
- when Convention_Assembler => return Name_Assembler;
- when Convention_C => return Name_C;
- when Convention_CIL => return Name_CIL;
- when Convention_COBOL => return Name_COBOL;
- when Convention_CPP => return Name_CPP;
- when Convention_Entry => return Name_Entry;
- when Convention_Fortran => return Name_Fortran;
- when Convention_Intrinsic => return Name_Intrinsic;
- when Convention_Java => return Name_Java;
- when Convention_Protected => return Name_Protected;
- when Convention_Stdcall => return Name_Stdcall;
- when Convention_Stubbed => return Name_Stubbed;
+ when Convention_Ada => return Name_Ada;
+ when Convention_Ada_Pass_By_Copy => return Name_Ada_Pass_By_Copy;
+ when Convention_Ada_Pass_By_Reference =>
+ return Name_Ada_Pass_By_Reference;
+ when Convention_Assembler => return Name_Assembler;
+ when Convention_C => return Name_C;
+ when Convention_CIL => return Name_CIL;
+ when Convention_COBOL => return Name_COBOL;
+ when Convention_CPP => return Name_CPP;
+ when Convention_Entry => return Name_Entry;
+ when Convention_Fortran => return Name_Fortran;
+ when Convention_Intrinsic => return Name_Intrinsic;
+ when Convention_Java => return Name_Java;
+ when Convention_Protected => return Name_Protected;
+ when Convention_Stdcall => return Name_Stdcall;
+ when Convention_Stubbed => return Name_Stubbed;
end case;
end Get_Convention_Name;
Index: snames.ads-tmpl
===================================================================
--- snames.ads-tmpl (revision 177147)
+++ snames.ads-tmpl (working copy)
@@ -579,6 +579,8 @@
First_Convention_Name : constant Name_Id := N + $;
Name_Ada : constant Name_Id := N + $;
+ Name_Ada_Pass_By_Copy : constant Name_Id := N + $;
+ Name_Ada_Pass_By_Reference : constant Name_Id := N + $;
Name_Assembler : constant Name_Id := N + $;
Name_CIL : constant Name_Id := N + $;
Name_COBOL : constant Name_Id := N + $;
@@ -1424,6 +1426,12 @@
Convention_Protected,
Convention_Stubbed,
+ -- The following conventions are equivalent to Ada for all purposes
+ -- except controlling the way parameters are passed.
+
+ Convention_Ada_Pass_By_Copy,
+ Convention_Ada_Pass_By_Reference,
+
-- The remaining conventions are foreign language conventions
Convention_Assembler, -- also Asm, Assembly
@@ -1435,10 +1443,10 @@
Convention_Java,
Convention_Stdcall); -- also DLL, Win32
- -- Note: Convention C_Pass_By_Copy is allowed only for record
- -- types (where it is treated like C except that the appropriate
- -- flag is set in the record type). Recognizing this convention
- -- is specially handled in Sem_Prag.
+ -- Note: Convention C_Pass_By_Copy is allowed only for record types
+ -- (where it is treated like C except that the appropriate flag is set
+ -- in the record type). Recognizing this convention is specially handled
+ -- in Sem_Prag.
for Convention_Id'Size use 8;
-- Plenty of space for expansion
