diff options
author | Tom Tromey <tromey@adacore.com> | 2023-06-30 09:31:40 -0600 |
---|---|---|
committer | Marc Poulhiès <poulhies@adacore.com> | 2023-07-28 09:28:13 +0200 |
commit | 5d8fc02062b36e58c9d0bd39e7c9bb286335d870 (patch) | |
tree | e4dbc0452ae0bb0f82ff9dfbc824ba30257981c5 | |
parent | 7e448f3c3dfb53a0d9e0b67c2fef566a56942596 (diff) | |
download | gcc-5d8fc02062b36e58c9d0bd39e7c9bb286335d870.zip gcc-5d8fc02062b36e58c9d0bd39e7c9bb286335d870.tar.gz gcc-5d8fc02062b36e58c9d0bd39e7c9bb286335d870.tar.bz2 |
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.
-rw-r--r-- | gcc/ada/fe.h | 8 | ||||
-rw-r--r-- | gcc/ada/gen_il-gen.adb | 11 | ||||
-rw-r--r-- | gcc/ada/snames.h-tmpl | 56 | ||||
-rw-r--r-- | gcc/ada/types.h | 8 | ||||
-rw-r--r-- | 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 f283064..ca77f43 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 bf760f3..1cee17c 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 95b3c77..f01642f 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 3004de6..aa0b2a6 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 979750f..576cf76 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"); |