From 5d8fc02062b36e58c9d0bd39e7c9bb286335d870 Mon Sep 17 00:00:00 2001
From: Tom Tromey <tromey@adacore.com>
Date: Fri, 30 Jun 2023 09:31:40 -0600
Subject: [PATCH] ada: Emit enums rather than defines for various constants
This patch changes xsnamest and gen_il-gen to emit various constants
as enums rather than a sequence of preprocessor defines. This enables
better debugging and somewhat better type safety.
gcc/ada/
* fe.h (Convention): Now inline function.
* gen_il-gen.adb (Put_C_Type_And_Subtypes.Put_Enum_Lit)
(Put_C_Type_And_Subtypes.Put_Kind_Subtype, Put_C_Getter):
Emit enum.
* snames.h-tmpl (Name_Id, Name_, Attribute_Id, Attribute_)
(Convention_Id, Convention_, Pragma_Id, Pragma_): Now enum.
(Get_Attribute_Id, Get_Pragma_Id): Now inline functions.
* types.h (Node_Kind, Entity_Kind, Convention_Id, Name_Id):
Now enum.
* xsnamest.adb (Output_Header_Line, Make_Value): Emit enum.
---
gcc/ada/fe.h | 8 ++++--
gcc/ada/gen_il-gen.adb | 11 ++++++---
gcc/ada/snames.h-tmpl | 56 +++++++++++++++++++++++++-----------------
gcc/ada/types.h | 8 +++---
gcc/ada/xsnamest.adb | 30 +++++++++++++---------
5 files changed, 69 insertions(+), 44 deletions(-)
diff --git a/gcc/ada/fe.h b/gcc/ada/fe.h
index f283064c7286..ca77f433cfad 100644
--- a/gcc/ada/fe.h
+++ b/gcc/ada/fe.h
@@ -683,8 +683,12 @@ Entity_Kind Parameter_Mode (E Id);
// The following is needed because Convention in Sem_Util is a renaming
// of Basic_Convention.
-#define Convention einfo__entities__basic_convention
-Convention_Id Convention (N Node);
+static inline Convention_Id
+Convention (N Node)
+{
+ extern Byte einfo__entities__basic_convention (N Node);
+ return (Convention_Id) einfo__entities__basic_convention (Node);
+}
// See comments regarding Entity_Or_Associated_Node in Sinfo.Utils.
diff --git a/gcc/ada/gen_il-gen.adb b/gcc/ada/gen_il-gen.adb
index bf760f3d917a..1cee17caf769 100644
--- a/gcc/ada/gen_il-gen.adb
+++ b/gcc/ada/gen_il-gen.adb
@@ -2957,9 +2957,9 @@ package body Gen_IL.Gen is
-- Current Node_Kind'Pos or Entity_Kind'Pos to be printed
procedure Put_Enum_Lit (T : Node_Or_Entity_Type);
- -- Print out the #define corresponding to the Ada enumeration literal
+ -- Print out the enumerator corresponding to the Ada enumeration literal
-- for T in Node_Kind and Entity_Kind (i.e. concrete types).
- -- This looks like "#define Some_Kind <pos>", where Some_Kind
+ -- This looks like "Some_Kind = <pos>", where Some_Kind
-- is the Node_Kind or Entity_Kind enumeration literal, and
-- <pos> is Node_Kind'Pos or Entity_Kind'Pos of that literal.
@@ -2970,7 +2970,7 @@ package body Gen_IL.Gen is
procedure Put_Enum_Lit (T : Node_Or_Entity_Type) is
begin
if T in Concrete_Type then
- Put (S, "#define " & Image (T) & " " & Image (Cur_Pos) & LF);
+ Put (S, " " & Image (T) & " = " & Image (Cur_Pos) & "," & LF);
Cur_Pos := Cur_Pos + 1;
end if;
end Put_Enum_Lit;
@@ -2990,7 +2990,9 @@ package body Gen_IL.Gen is
begin
Put_Union_Membership (S, Root, Only_Prototypes => True);
+ Put (S, "enum " & Node_Or_Entity (Root) & "_Kind : unsigned int {" & LF);
Iterate_Types (Root, Pre => Put_Enum_Lit'Access);
+ Put (S, "};" & LF);
Put (S, "#define Number_" & Node_Or_Entity (Root) & "_Kinds " &
Image (Cur_Pos) & "" & LF & LF);
@@ -3046,7 +3048,8 @@ package body Gen_IL.Gen is
Put (S, "unsigned int Raw = slot;" & LF);
end if;
- Put (S, Get_Set_Id_Image (Rec.Field_Type) & " val = ");
+ Put (S, Get_Set_Id_Image (Rec.Field_Type) & " val = (" &
+ Get_Set_Id_Image (Rec.Field_Type) & ") ");
if Field_Has_Special_Default (Rec.Field_Type) then
Increase_Indent (S, 2);
diff --git a/gcc/ada/snames.h-tmpl b/gcc/ada/snames.h-tmpl
index 95b3c7761977..f01642ffbff8 100644
--- a/gcc/ada/snames.h-tmpl
+++ b/gcc/ada/snames.h-tmpl
@@ -28,43 +28,55 @@
/* Name_Id values */
-typedef Int Name_Id;
-#define Name_ !! TEMPLATE INSERTION POINT
+enum Name_Id : Int
+{
+ Name_ !! TEMPLATE INSERTION POINT
+};
-/* Define the function to return one of the numeric values below. Note
- that it actually returns a char since an enumeration value of less
- than 256 entries is represented that way in Ada. The operand is a Chars
- field value. */
+/* Define the numeric values for attributes. */
-typedef Byte Attribute_Id;
-#define Get_Attribute_Id snames__get_attribute_id
-extern Attribute_Id Get_Attribute_Id (int);
+enum Attribute_Id : unsigned char
+{
+ Attr_ !! TEMPLATE INSERTION POINT
+};
-/* Define the numeric values for attributes. */
+/* Define the function to return one of the numeric values above. The operand
+ is a Chars field value. */
-#define Attr_ !! TEMPLATE INSERTION POINT
+static inline Attribute_Id
+Get_Attribute_Id (int id)
+{
+ extern unsigned char snames__get_attribute_id (int);
+ return (Attribute_Id) snames__get_attribute_id (id);
+}
/* Define the numeric values for the conventions. */
-typedef Byte Convention_Id;
-#define Convention_ !! TEMPLATE INSERTION POINT
+enum Convention_Id : Byte
+{
+ Convention_ !! TEMPLATE INSERTION POINT
+};
/* Define the function to check if a Name_Id value is a valid pragma */
#define Is_Pragma_Name snames__is_pragma_name
extern Boolean Is_Pragma_Name (Name_Id);
-/* Define the function to return one of the numeric values below. Note
- that it actually returns a char since an enumeration value of less
- than 256 entries is represented that way in Ada. The operand is a Chars
- field value. */
+/* Define the numeric values for the pragmas. */
-typedef Byte Pragma_Id;
-#define Get_Pragma_Id snames__get_pragma_id
-extern Pragma_Id Get_Pragma_Id (int);
+enum Pragma_Id : Byte
+{
+ Pragma_ !! TEMPLATE_INSERTION_POINT
+};
-/* Define the numeric values for the pragmas. */
+/* Define the function to return one of the numeric values above. The operand
+ is a Chars field value. */
-#define Pragma_ !! TEMPLATE_INSERTION_POINT
+static inline Pragma_Id
+Get_Pragma_Id (int id)
+{
+ extern unsigned char snames__get_pragma_id (int);
+ return (Pragma_Id) snames__get_pragma_id (id);
+}
/* End of snames.h (C version of Snames package spec) */
diff --git a/gcc/ada/types.h b/gcc/ada/types.h
index 3004de658aa5..aa0b2a67b842 100644
--- a/gcc/ada/types.h
+++ b/gcc/ada/types.h
@@ -102,8 +102,8 @@ typedef struct { const char *Array; String_Template *Bounds; }
once again, the annoying restriction on bit fields for some compilers
bites us! */
-typedef unsigned int Node_Kind;
-typedef unsigned int Entity_Kind;
+enum Node_Kind : unsigned int;
+enum Entity_Kind : unsigned int;
/* Types used for Text Buffer Handling: */
@@ -140,7 +140,7 @@ typedef Text_Ptr Source_Ptr;
#define Standard_Location -2
/* Convention identifiers. */
-typedef Byte Convention_Id;
+enum Convention_Id : Byte;
/* Instance identifiers. */
typedef Nat Instance_Id;
@@ -188,7 +188,7 @@ SUBTYPE (Ureal_Range, Int, Ureal_Low_Bound, Ureal_High_Bound)
/* Types for Names_Table Package: */
-typedef Int Name_Id;
+enum Name_Id : Int;
/* Name_Id value for no name present. */
#define No_Name Names_Low_Bound
diff --git a/gcc/ada/xsnamest.adb b/gcc/ada/xsnamest.adb
index 979750faf7e9..576cf76c9603 100644
--- a/gcc/ada/xsnamest.adb
+++ b/gcc/ada/xsnamest.adb
@@ -119,13 +119,17 @@ procedure XSnamesT is
Header_Current_Symbol : Header_Symbol := None;
Header_Pending_Line : VString := Nul;
+ -- Subtypes we will emit after an enum
+
+ Generated_C_Subtypes : Unbounded_String;
+
------------------------
-- Output_Header_Line --
------------------------
procedure Output_Header_Line (S : Header_Symbol) is
function Make_Value (V : Integer) return String;
- -- Build the definition for the current macro (Names are integers
+ -- Build the definition for the current enumerator (Names are integers
-- offset to N, while other items are enumeration values).
----------------
@@ -144,14 +148,14 @@ procedure XSnamesT is
-- Start of processing for Output_Header_Line
begin
- -- Skip all the #define for S-prefixed symbols in the header.
+ -- Skip all the enumerator for S-prefixed symbols in the header.
-- Of course we are making implicit assumptions:
-- (1) No newline between symbols with the same prefix.
-- (2) Prefix order is the same as in snames.ads.
if Header_Current_Symbol /= S then
declare
- Pat : constant Pattern := "#define "
+ Pat : constant Pattern := " "
& Header_Prefix (S).all
& Break (' ') * Name2;
In_Pat : Boolean := False;
@@ -180,14 +184,12 @@ procedure XSnamesT is
-- Now output the line
- -- Note that we must ensure at least one space between macro name and
- -- parens, otherwise the parenthesized value gets treated as an argument
- -- specification.
-
- Put_Line (OutH, "#define " & Header_Prefix (S).all
+ Put_Line (OutH, " " & Header_Prefix (S).all
& "_" & Name1
& (30 - Natural'Min (29, Length (Name1))) * ' '
- & Make_Value (Header_Counter (S)));
+ & " = "
+ & Make_Value (Header_Counter (S))
+ & ",");
Header_Counter (S) := Header_Counter (S) + 1;
end Output_Header_Line;
@@ -235,10 +237,12 @@ begin
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 & ", ");
+ Generated_C_Subtypes := Generated_C_Subtypes & ASCII.LF
+ & "SUBTYPE (" & Name1 & ", " & Name2
+ & ", ";
elsif Match (Line, Get_Subt2) and then Match (Name1, Is_Conv) then
- Put_Line (OutH, " " & Name1 & ", " & Name2 & ')');
+ Generated_C_Subtypes := Generated_C_Subtypes & ASCII.LF
+ & " " & Name1 & ", " & Name2 & ')';
end if;
else
@@ -297,6 +301,8 @@ begin
Put_Line (OutH, Line);
end loop;
+ Put_Line (OutH, Generated_C_Subtypes);
+ Put_Line (OutH, "");
Put_Line (OutH, "#ifdef __cplusplus");
Put_Line (OutH, "}");
Put_Line (OutH, "#endif");
--
GitLab