[Ada] Implement AI12-0028: Import of variadic C functions

2020-06-09  Eric Botcazou  <ebotcazou@adacore.com>

gcc/ada/

	* exp_ch6.adb (Freeze_Subprogram): Deal with convention C_Family.
	* freeze.adb (Freeze_Profile): Likewise.  Add missing guard.
	* sem_mech.adb (Set_Mechanisms): Likewise.
	* lib-xref.adb (Output_Import_Export_Info): Ditto for C_Variadic.
	* repinfo.adb (List_Subprogram_Info): Likewise.
	* sem_prag.adb (Set_Convention_From_Pragma): Move main checks for
	Stdcall to...
	(Process_Convention): ...here.  Add checks for C_Variadic.
	* snames.ads-tmpl: Add Name_C_Variadic_0 .. Name_C_Variadic_16.
	Use consistent format for subtype declarations.
	(Convention_Id): Add Convention_C_Variadic_0 .. C_Variadic_16
	and move Convention_CPP up.
	(Convention_C_Family): New subtype of Convention_Id.
	(Convention_C_Variadic): Likewise.
	(Foreign_Convention): Use explicit upper bound.
	Add pragma Inline for Is_Configuration_Pragma_Name,
	Is_Function_Attribute_Name, Is_Internal_Attribute_Name
	and Is_Procedure_Attribute_Name.
	* snames.adb-tmpl (Get_Convention_Id): Deal with Name_Variadic_n.
	(Get_Convention_Name): Deal with Convention_Variadic_n.
	* types.h (Convention_Id): New typedef.
	* xsnamest.adb (Name2): New variable.
	(Is_Conv): New pattern.
	(Get_Subt1): Likewise.
	(Get_Subt2): Likewise.
	Output subtypes of Convention_Id into the C header file.

10 files changed, 278 insertions, 107 deletions

diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
index e948580..5a0cbf4 100644
--- a/gcc/ada/exp_ch6.adb
+++ b/gcc/ada/exp_ch6.adb
@@ -7716,8 +7716,7 @@ package body Exp_Ch6 is
             --  Build_Inherit_Prims takes care of initializing these slots.
 
             elsif Is_Imported (Subp)
-               and then (Convention (Subp) = Convention_CPP
-                           or else Convention (Subp) = Convention_C)
+               and then Convention (Subp) in Convention_C_Family
             then
                null;
 
diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb
index 673756f..d562b1e 100644
--- a/gcc/ada/freeze.adb
+++ b/gcc/ada/freeze.adb
@@ -3674,9 +3674,7 @@ package body Freeze is
 
             if Warn_On_Export_Import
               and then Comes_From_Source (E)
-              and then (Convention (E) = Convention_C
-                          or else
-                        Convention (E) = Convention_CPP)
+              and then Convention (E) in Convention_C_Family
               and then (Is_Imported (E) or else Is_Exported (E))
               and then Convention (E) /= Convention (Formal)
               and then not Has_Warnings_Off (E)
@@ -3823,9 +3821,8 @@ package body Freeze is
             --  Check suspicious return type for C function
 
             if Warn_On_Export_Import
-              and then (Convention (E) = Convention_C
-                          or else
-                        Convention (E) = Convention_CPP)
+              and then Comes_From_Source (E)
+              and then Convention (E) in Convention_C_Family
               and then (Is_Imported (E) or else Is_Exported (E))
             then
                --  Check suspicious return of fat C pointer
diff --git a/gcc/ada/lib-xref.adb b/gcc/ada/lib-xref.adb
index bb7c400..2c313ea 100644
--- a/gcc/ada/lib-xref.adb
+++ b/gcc/ada/lib-xref.adb
@@ -1652,7 +1652,7 @@ package body Lib.Xref is
       begin
          --  Generate language name from convention
 
-         if Conv  = Convention_C then
+         if Conv = Convention_C or else Conv in Convention_C_Variadic then
             Language_Name := Name_C;
 
          elsif Conv = Convention_CPP then
diff --git a/gcc/ada/repinfo.adb b/gcc/ada/repinfo.adb
index d02214c..322b5f9 100644
--- a/gcc/ada/repinfo.adb
+++ b/gcc/ada/repinfo.adb
@@ -1935,6 +1935,21 @@ package body Repinfo is
          when Convention_C =>
             Write_Str ("C");
 
+         when Convention_C_Variadic =>
+            declare
+               N : Nat :=
+                 Convention_Id'Pos (Convention (Ent)) -
+                   Convention_Id'Pos (Convention_C_Variadic_0);
+            begin
+               Write_Str ("C_Variadic_");
+               if N >= 10 then
+                  Write_Char ('1');
+                  N := N - 10;
+               end if;
+               pragma Assert (N < 10);
+               Write_Char (Character'Val (Character'Pos ('0') + N));
+            end;
+
          when Convention_COBOL =>
             Write_Str ("COBOL");
 
diff --git a/gcc/ada/sem_mech.adb b/gcc/ada/sem_mech.adb
index 6ae957c..0c6c822 100644
--- a/gcc/ada/sem_mech.adb
+++ b/gcc/ada/sem_mech.adb
@@ -181,11 +181,10 @@ package body Sem_Mech is
                -- C --
                -------
 
-               --  Note: Assembler, C++, Stdcall also use C conventions
+               --  Note: Assembler and Stdcall also use C conventions
 
                when Convention_Assembler
-                  | Convention_C
-                  | Convention_CPP
+                  | Convention_C_Family
                   | Convention_Stdcall
                =>
                   --  The following values are passed by copy
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index 8040374..666b54d 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -7957,59 +7957,24 @@ package body Sem_Prag is
                Error_Pragma_Arg
                  ("cannot change convention for overridden dispatching "
                   & "operation", Arg1);
-            end if;
-
-            --  Special checks for Convention_Stdcall
-
-            if C = Convention_Stdcall then
-
-               --  A dispatching call is not allowed. A dispatching subprogram
-               --  cannot be used to interface to the Win32 API, so in fact
-               --  this check does not impose any effective restriction.
-
-               if Is_Dispatching_Operation (E) then
-                  Error_Msg_Sloc := Sloc (E);
-
-                  --  Note: make this unconditional so that if there is more
-                  --  than one call to which the pragma applies, we get a
-                  --  message for each call. Also don't use Error_Pragma,
-                  --  so that we get multiple messages.
-
-                  Error_Msg_N
-                    ("dispatching subprogram# cannot use Stdcall convention!",
-                     Arg1);
-
-               --  Several allowed cases
-
-               elsif Is_Subprogram_Or_Generic_Subprogram (E)
 
-                 --  A variable is OK
+            --  Special check for convention Stdcall: a dispatching call is not
+            --  allowed. A dispatching subprogram cannot be used to interface
+            --  to the Win32 API, so this check actually does not impose any
+            --  effective restriction.
 
-                 or else Ekind (E) = E_Variable
-
-                 --  A component as well. The entity does not have its Ekind
-                 --  set until the enclosing record declaration is fully
-                 --  analyzed.
-
-                 or else Nkind (Parent (E)) = N_Component_Declaration
-
-                 --  An access to subprogram is also allowed
-
-                 or else
-                   (Is_Access_Type (E)
-                     and then Ekind (Designated_Type (E)) = E_Subprogram_Type)
-
-                 --  Allow internal call to set convention of subprogram type
-
-                 or else Ekind (E) = E_Subprogram_Type
-               then
-                  null;
+            elsif Is_Dispatching_Operation (E)
+              and then C = Convention_Stdcall
+            then
+               --  Note: make this unconditional so that if there is more
+               --  than one call to which the pragma applies, we get a
+               --  message for each call. Also don't use Error_Pragma,
+               --  so that we get multiple messages.
 
-               else
-                  Error_Pragma_Arg
-                    ("second argument of pragma% must be subprogram (type)",
-                     Arg2);
-               end if;
+               Error_Msg_Sloc := Sloc (E);
+               Error_Msg_N
+                 ("dispatching subprogram# cannot use Stdcall convention!",
+                  Get_Pragma_Arg (Arg1));
             end if;
 
             --  Set the convention
@@ -8113,6 +8078,7 @@ package body Sem_Prag is
          E         : Entity_Id;
          E1        : Entity_Id;
          Id        : Node_Id;
+         Subp      : Entity_Id;
 
       --  Start of processing for Process_Convention
 
@@ -8284,13 +8250,114 @@ package body Sem_Prag is
                Error_Pragma_Arg
                  ("second argument of pragma% must be a subprogram", Arg2);
             end if;
+
+         --  Special checks for C_Variadic_n
+
+         elsif C in Convention_C_Variadic then
+
+            --  Several allowed cases
+
+            if Is_Subprogram_Or_Generic_Subprogram (E) then
+               Subp := E;
+
+            --  An access to subprogram is also allowed
+
+            elsif Is_Access_Type (E)
+              and then Ekind (Designated_Type (E)) = E_Subprogram_Type
+            then
+               Subp := Designated_Type (E);
+
+            --  Allow internal call to set convention of subprogram type
+
+            elsif Ekind (E) = E_Subprogram_Type then
+               Subp := E;
+
+            else
+               Error_Pragma_Arg
+                 ("argument of pragma% must be subprogram or access type",
+                  Arg2);
+               Subp := Empty;
+            end if;
+
+            --  ISO C requires a named parameter before the ellipsis, so a
+            --  variadic C function taking 0 fixed parameter cannot exist.
+
+            if C = Convention_C_Variadic_0 then
+
+               Error_Msg_N
+                 ("??C_Variadic_0 cannot be used for an 'I'S'O C function",
+                  Get_Pragma_Arg (Arg2));
+
+            --  Now check the number of parameters of the subprogram
+
+            elsif Present (Subp) then
+               declare
+                  Minimum : constant Nat :=
+                    Convention_Id'Pos (C) -
+                      Convention_Id'Pos (Convention_C_Variadic_0);
+
+                  Count  : Nat;
+                  Formal : Entity_Id;
+
+               begin
+                  Count := 0;
+                  Formal := First_Formal (Subp);
+                  while Present (Formal) loop
+                     Count := Count + 1;
+                     Next_Formal (Formal);
+                  end loop;
+
+                  if Count < Minimum then
+                     Error_Msg_Uint_1 := UI_From_Int (Minimum);
+                     Error_Pragma_Arg
+                       ("argument of pragma% must have at least"
+                        & "^ parameters", Arg2);
+                  end if;
+               end;
+            end if;
+
+         --  Special checks for Stdcall
+
+         elsif C = Convention_Stdcall then
+
+            --  Several allowed cases
+
+            if Is_Subprogram_Or_Generic_Subprogram (E)
+
+              --  A variable is OK
+
+              or else Ekind (E) = E_Variable
+
+              --  A component as well. The entity does not have its Ekind
+              --  set until the enclosing record declaration is fully
+              --  analyzed.
+
+              or else Nkind (Parent (E)) = N_Component_Declaration
+
+              --  An access to subprogram is also allowed
+
+              or else
+                (Is_Access_Type (E)
+                  and then Ekind (Designated_Type (E)) = E_Subprogram_Type)
+
+              --  Allow internal call to set convention of subprogram type
+
+              or else Ekind (E) = E_Subprogram_Type
+            then
+               null;
+
+            else
+               Error_Pragma_Arg
+                 ("argument of pragma% must be subprogram or access type",
+                  Arg2);
+            end if;
          end if;
 
+         Set_Convention_From_Pragma (E);
+
          --  Deal with non-subprogram cases
 
          if not Is_Subprogram_Or_Generic_Subprogram (E) then
-            Set_Convention_From_Pragma (E);
-
             if Is_Type (E) then
 
                --  The pragma must apply to a first subtype, but it can also
@@ -8318,9 +8385,6 @@ package body Sem_Prag is
          --  compilation unit.
 
          else
-            Comp_Unit := Get_Source_Unit (E);
-            Set_Convention_From_Pragma (E);
-
             --  Treat a pragma Import as an implicit body, and pragma import
             --  as implicit reference (for navigation in GNAT Studio).
 
@@ -8365,6 +8429,7 @@ package body Sem_Prag is
             --  Otherwise Loop through the homonyms of the pragma argument's
             --  entity, an apply convention to those in the current scope.
 
+            Comp_Unit := Get_Source_Unit (E);
             E1 := Ent;
 
             loop
diff --git a/gcc/ada/snames.adb-tmpl b/gcc/ada/snames.adb-tmpl
index a03cafb..ce9c63d 100644
--- a/gcc/ada/snames.adb-tmpl
+++ b/gcc/ada/snames.adb-tmpl
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2016, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2020, 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- --
@@ -155,6 +155,23 @@ package body Snames is
                                               Convention_Ada_Pass_By_Reference;
          when Name_Assembler             => return Convention_Assembler;
          when Name_C                     => return Convention_C;
+         when Name_C_Variadic_0          => return Convention_C_Variadic_0;
+         when Name_C_Variadic_1          => return Convention_C_Variadic_1;
+         when Name_C_Variadic_2          => return Convention_C_Variadic_2;
+         when Name_C_Variadic_3          => return Convention_C_Variadic_3;
+         when Name_C_Variadic_4          => return Convention_C_Variadic_4;
+         when Name_C_Variadic_5          => return Convention_C_Variadic_5;
+         when Name_C_Variadic_6          => return Convention_C_Variadic_6;
+         when Name_C_Variadic_7          => return Convention_C_Variadic_7;
+         when Name_C_Variadic_8          => return Convention_C_Variadic_8;
+         when Name_C_Variadic_9          => return Convention_C_Variadic_9;
+         when Name_C_Variadic_10         => return Convention_C_Variadic_10;
+         when Name_C_Variadic_11         => return Convention_C_Variadic_11;
+         when Name_C_Variadic_12         => return Convention_C_Variadic_12;
+         when Name_C_Variadic_13         => return Convention_C_Variadic_13;
+         when Name_C_Variadic_14         => return Convention_C_Variadic_14;
+         when Name_C_Variadic_15         => return Convention_C_Variadic_15;
+         when Name_C_Variadic_16         => return Convention_C_Variadic_16;
          when Name_COBOL                 => return Convention_COBOL;
          when Name_CPP                   => return Convention_CPP;
          when Name_Fortran               => return Convention_Fortran;
@@ -189,6 +206,23 @@ package body Snames is
             return Name_Ada_Pass_By_Reference;
          when Convention_Assembler             => return Name_Assembler;
          when Convention_C                     => return Name_C;
+         when Convention_C_Variadic_0          => return Name_C_Variadic_0;
+         when Convention_C_Variadic_1          => return Name_C_Variadic_1;
+         when Convention_C_Variadic_2          => return Name_C_Variadic_2;
+         when Convention_C_Variadic_3          => return Name_C_Variadic_3;
+         when Convention_C_Variadic_4          => return Name_C_Variadic_4;
+         when Convention_C_Variadic_5          => return Name_C_Variadic_5;
+         when Convention_C_Variadic_6          => return Name_C_Variadic_6;
+         when Convention_C_Variadic_7          => return Name_C_Variadic_7;
+         when Convention_C_Variadic_8          => return Name_C_Variadic_8;
+         when Convention_C_Variadic_9          => return Name_C_Variadic_9;
+         when Convention_C_Variadic_10         => return Name_C_Variadic_10;
+         when Convention_C_Variadic_11         => return Name_C_Variadic_11;
+         when Convention_C_Variadic_12         => return Name_C_Variadic_12;
+         when Convention_C_Variadic_13         => return Name_C_Variadic_13;
+         when Convention_C_Variadic_14         => return Name_C_Variadic_14;
+         when Convention_C_Variadic_15         => return Name_C_Variadic_15;
+         when Convention_C_Variadic_16         => return Name_C_Variadic_16;
          when Convention_COBOL                 => return Name_COBOL;
          when Convention_CPP                   => return Name_CPP;
          when Convention_Entry                 => return Name_Entry;
@@ -425,9 +459,9 @@ package body Snames is
       return N in First_Locking_Policy_Name .. Last_Locking_Policy_Name;
    end Is_Locking_Policy_Name;
 
-   -------------------------------------
-   -- Is_Partition_Elaboration_Policy --
-   -------------------------------------
+   ------------------------------------------
+   -- Is_Partition_Elaboration_Policy_Name --
+   ------------------------------------------
 
    function Is_Partition_Elaboration_Policy_Name
      (N : Name_Id) return Boolean
diff --git a/gcc/ada/snames.ads-tmpl b/gcc/ada/snames.ads-tmpl
index b88f861..0f39a97 100644
--- a/gcc/ada/snames.ads-tmpl
+++ b/gcc/ada/snames.ads-tmpl
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2017, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2020, 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- --
@@ -705,6 +705,23 @@ package Snames is
    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_C_Variadic_0                   : constant Name_Id := N + $;
+   Name_C_Variadic_1                   : constant Name_Id := N + $;
+   Name_C_Variadic_2                   : constant Name_Id := N + $;
+   Name_C_Variadic_3                   : constant Name_Id := N + $;
+   Name_C_Variadic_4                   : constant Name_Id := N + $;
+   Name_C_Variadic_5                   : constant Name_Id := N + $;
+   Name_C_Variadic_6                   : constant Name_Id := N + $;
+   Name_C_Variadic_7                   : constant Name_Id := N + $;
+   Name_C_Variadic_8                   : constant Name_Id := N + $;
+   Name_C_Variadic_9                   : constant Name_Id := N + $;
+   Name_C_Variadic_10                  : constant Name_Id := N + $;
+   Name_C_Variadic_11                  : constant Name_Id := N + $;
+   Name_C_Variadic_12                  : constant Name_Id := N + $;
+   Name_C_Variadic_13                  : constant Name_Id := N + $;
+   Name_C_Variadic_14                  : constant Name_Id := N + $;
+   Name_C_Variadic_15                  : constant Name_Id := N + $;
+   Name_C_Variadic_16                  : constant Name_Id := N + $;
    Name_COBOL                          : constant Name_Id := N + $;
    Name_CPP                            : constant Name_Id := N + $;
    Name_Fortran                        : constant Name_Id := N + $;
@@ -713,6 +730,9 @@ package Snames is
    Name_Stubbed                        : constant Name_Id := N + $;
    Last_Convention_Name                : constant Name_Id := N + $;
 
+   subtype Name_C_Variadic is Name_Id
+     range Name_C_Variadic_0 .. Name_C_Variadic_16;
+
    --  The following names are preset as synonyms for Assembler
 
    Name_Asm                            : constant Name_Id := N + $;
@@ -1166,14 +1186,14 @@ package Snames is
    Name_Unsigned_32                    : constant Name_Id := N + $; -- GNAT
    Name_Unsigned_64                    : constant Name_Id := N + $; -- GNAT
 
-   subtype Scalar_Id is Name_Id range
-     Name_Short_Float .. Name_Unsigned_64;
+   subtype Scalar_Id is Name_Id
+     range Name_Short_Float .. Name_Unsigned_64;
 
-   subtype Float_Scalar_Id is Name_Id range
-     Name_Short_Float .. Name_Long_Long_Float;
+   subtype Float_Scalar_Id is Name_Id
+     range Name_Short_Float .. Name_Long_Long_Float;
 
-   subtype Integer_Scalar_Id is Name_Id range
-     Name_Signed_8 .. Name_Unsigned_64;
+   subtype Integer_Scalar_Id is Name_Id
+     range Name_Signed_8 .. Name_Unsigned_64;
 
    --  Names of recognized checks for pragma Suppress
 
@@ -1314,8 +1334,8 @@ package Snames is
    Name_Tagged                           : constant Name_Id := N + $;
    Last_95_Reserved_Word                 : constant Name_Id := N + $;
 
-   subtype Ada_95_Reserved_Words is
-     Name_Id range First_95_Reserved_Word .. Last_95_Reserved_Word;
+   subtype Ada_95_Reserved_Words is Name_Id
+     range First_95_Reserved_Word .. Last_95_Reserved_Word;
 
    --  Miscellaneous names used in semantic checking
 
@@ -1526,8 +1546,8 @@ package Snames is
    Name_Synchronized                     : constant Name_Id := N + $;
    Last_2005_Reserved_Word               : constant Name_Id := N + $;
 
-   subtype Ada_2005_Reserved_Words is
-     Name_Id range First_2005_Reserved_Word .. Last_2005_Reserved_Word;
+   subtype Ada_2005_Reserved_Words is Name_Id
+     range First_2005_Reserved_Word .. Last_2005_Reserved_Word;
 
    --  Ada 2012 reserved words
 
@@ -1535,8 +1555,8 @@ package Snames is
    Name_Some                             : constant Name_Id := N + $;
    Last_2012_Reserved_Word               : constant Name_Id := N + $;
 
-   subtype Ada_2012_Reserved_Words is
-     Name_Id range First_2012_Reserved_Word .. Last_2012_Reserved_Word;
+   subtype Ada_2012_Reserved_Words is Name_Id
+     range First_2012_Reserved_Word .. Last_2012_Reserved_Word;
 
    --  Mark last defined name for consistency check in Snames body
 
@@ -1546,11 +1566,11 @@ package Snames is
    -- Subtypes Defining Name Categories --
    ---------------------------------------
 
-   subtype Any_Operator_Name is Name_Id range
-     First_Operator_Name .. Last_Operator_Name;
+   subtype Any_Operator_Name is Name_Id
+     range First_Operator_Name .. Last_Operator_Name;
 
-   subtype Configuration_Pragma_Names is Name_Id range
-     First_Pragma_Name .. Last_Configuration_Pragma_Name;
+   subtype Configuration_Pragma_Names is Name_Id
+     range First_Pragma_Name .. Last_Configuration_Pragma_Name;
 
    ------------------------------
    -- Attribute ID Definitions --
@@ -1755,8 +1775,8 @@ package Snames is
       Attribute_Dispatching_Domain,
       Attribute_Interrupt_Priority);
 
-   subtype Internal_Attribute_Id is Attribute_Id range
-     Attribute_CPU .. Attribute_Interrupt_Priority;
+   subtype Internal_Attribute_Id is Attribute_Id
+     range Attribute_CPU .. Attribute_Interrupt_Priority;
 
    type Attribute_Class_Array is array (Attribute_Id) of Boolean;
    --  Type used to build attribute classification flag arrays
@@ -1784,12 +1804,29 @@ package Snames is
 
       --  The remaining conventions are foreign language conventions
 
-      Convention_Assembler,  --  also Asm, Assembly
-      Convention_C,          --  also Default, External
-      Convention_COBOL,
+      Convention_Assembler,      --  also Asm, Assembly
+      Convention_C,              --  also Default, External
+      Convention_C_Variadic_0,
+      Convention_C_Variadic_1,
+      Convention_C_Variadic_2,
+      Convention_C_Variadic_3,
+      Convention_C_Variadic_4,
+      Convention_C_Variadic_5,
+      Convention_C_Variadic_6,
+      Convention_C_Variadic_7,
+      Convention_C_Variadic_8,
+      Convention_C_Variadic_9,
+      Convention_C_Variadic_10,
+      Convention_C_Variadic_11,
+      Convention_C_Variadic_12,
+      Convention_C_Variadic_13,
+      Convention_C_Variadic_14,
+      Convention_C_Variadic_15,
+      Convention_C_Variadic_16,
       Convention_CPP,
+      Convention_COBOL,
       Convention_Fortran,
-      Convention_Stdcall);   --  also DLL, Win32
+      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
@@ -1799,8 +1836,14 @@ package Snames is
    for Convention_Id'Size use 8;
    --  Plenty of space for expansion
 
-   subtype Foreign_Convention is
-     Convention_Id range Convention_Assembler .. Convention_Id'Last;
+   subtype Convention_C_Family is Convention_Id
+     range Convention_C .. Convention_CPP;
+
+   subtype Convention_C_Variadic is Convention_Id
+     range Convention_C_Variadic_0 .. Convention_C_Variadic_16;
+
+   subtype Foreign_Convention is Convention_Id
+     range Convention_Assembler .. Convention_Stdcall;
 
    -----------------------------------
    -- Locking Policy ID Definitions --
@@ -2226,13 +2269,17 @@ package Snames is
 
 private
    pragma Inline (Is_Attribute_Name);
+   pragma Inline (Is_Configuration_Pragma_Name);
    pragma Inline (Is_Entity_Attribute_Name);
-   pragma Inline (Is_Type_Attribute_Name);
+   pragma Inline (Is_Function_Attribute_Name);
+   pragma Inline (Is_Internal_Attribute_Name);
    pragma Inline (Is_Locking_Policy_Name);
    pragma Inline (Is_Partition_Elaboration_Policy_Name);
    pragma Inline (Is_Operator_Symbol_Name);
-   pragma Inline (Is_Queuing_Policy_Name);
    pragma Inline (Is_Pragma_Name);
+   pragma Inline (Is_Procedure_Attribute_Name);
+   pragma Inline (Is_Queuing_Policy_Name);
    pragma Inline (Is_Task_Dispatching_Policy_Name);
+   pragma Inline (Is_Type_Attribute_Name);
 
 end Snames;
diff --git a/gcc/ada/types.h b/gcc/ada/types.h
index 2b6009f..e7eeae0 100644
--- a/gcc/ada/types.h
+++ b/gcc/ada/types.h
@@ -139,10 +139,13 @@ typedef Text_Ptr Source_Ptr;
 /* Used for Sloc in all nodes in the representation of package Standard.  */
 #define Standard_Location -2
 
-/* Instance identifiers */
+/* Convention identifiers.  */
+typedef Byte Convention_Id;
+
+/* Instance identifiers.  */
 typedef Nat Instance_Id;
 
-/* Type used for union of all possible ID values covering all ranges */
+/* Type used for union of all possible ID values covering all ranges.  */
 typedef int Union_Id;
 
 /* Range definitions for Tree Data:  */
diff --git a/gcc/ada/xsnamest.adb b/gcc/ada/xsnamest.adb
index 2c791c3..834d3c4 100644
--- a/gcc/ada/xsnamest.adb
+++ b/gcc/ada/xsnamest.adb
@@ -58,6 +58,7 @@ procedure XSnamesT is
    Line  : VString := Nul;
    Name0 : VString := Nul;
    Name1 : VString := Nul;
+   Name2 : VString := Nul;
    Oval  : VString := Nul;
    Restl : VString := Nul;
 
@@ -69,6 +70,7 @@ procedure XSnamesT is
    Get_Name : constant Pattern := "Name_" & Rest * Name1;
    Chk_Low  : constant Pattern := Pos (0) & Any (Lower_Set) & Rest & Pos (1);
    Findu    : constant Pattern := Span ('u') * A;
+   Is_Conv  : constant Pattern := "Convention_" & Rest;
 
    Val : Natural;
 
@@ -98,12 +100,18 @@ procedure XSnamesT is
 
    --  Patterns used in the spec file
 
-   Get_Attr : constant Pattern := Span (' ') & "Attribute_"
-                                  & Break (",)") * Name1;
-   Get_Conv : constant Pattern := Span (' ') & "Convention_"
-                                  & Break (",)") * Name1;
-   Get_Prag : constant Pattern := Span (' ') & "Pragma_"
-                                  & Break (",)") * Name1;
+   Get_Attr  : constant Pattern := Span (' ') & "Attribute_"
+                                   & Break (",)") * Name1;
+   Get_Conv  : constant Pattern := Span (' ') & "Convention_"
+                                   & Break (",)") * Name1;
+   Get_Prag  : constant Pattern := Span (' ') & "Pragma_"
+                                   & Break (",)") * Name1;
+   Get_Subt1 : constant Pattern := Span (' ') & "subtype "
+                                   & Break (' ') * Name1
+                                   & " is " & Rest * Name2;
+   Get_Subt2 : constant Pattern := Span (' ') & "range "
+                                   & Break (' ') * Name1
+                                   & " .. " & Break (";") * Name2;
 
    type Header_Symbol_Counter is array (Header_Symbol) of Natural;
    Header_Counter : Header_Symbol_Counter := (0, 0, 0, 0, 0);
@@ -143,7 +151,6 @@ procedure XSnamesT is
 
       if Header_Current_Symbol /= S then
          declare
-            Name2 : VString;
             Pat : constant Pattern := "#define  "
                                        & Header_Prefix (S).all
                                        & Break (' ') * Name2;
@@ -227,6 +234,11 @@ begin
             Output_Header_Line (Conv);
          elsif Match (Line, Get_Prag) then
             Output_Header_Line (Prag);
+         elsif Match (Line, Get_Subt1) and then Match (Name2, Is_Conv) then
+            New_Line (OutH);
+            Put_Line (OutH, "SUBTYPE (" & Name1 & ", " & Name2 & ", ");
+         elsif Match (Line, Get_Subt2) and then Match (Name1, Is_Conv) then
+            Put_Line (OutH, "   " & Name1 & ", " & Name2 & ')');
          end if;
       else