diff options
| author | Eric Botcazou <ebotcazou@adacore.com> | 2020-03-03 12:44:18 +0100 |
|---|---|---|
| committer | Pierre-Marie de Rodat <derodat@adacore.com> | 2020-06-09 04:09:06 -0400 |
| commit | fd66407104b2133f0e55deb84db787c692a21948 (patch) | |
| tree | 628e3735093268193368896af1156e6831f4cb18 /gcc/ada/xsnamest.adb | |
| parent | 2d6f6e08e69209d3df5b49b738c08ce3e921bf44 (diff) | |
| download | gcc-fd66407104b2133f0e55deb84db787c692a21948.zip gcc-fd66407104b2133f0e55deb84db787c692a21948.tar.gz gcc-fd66407104b2133f0e55deb84db787c692a21948.tar.bz2 | |
[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.
Diffstat (limited to 'gcc/ada/xsnamest.adb')
| -rw-r--r-- | gcc/ada/xsnamest.adb | 26 |
1 files changed, 19 insertions, 7 deletions
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 |