diff options
| -rw-r--r-- | src/grt/grt-images.adb | 36 | ||||
| -rw-r--r-- | src/name_table.ads | 4 | ||||
| -rw-r--r-- | src/str_table.adb | 7 | ||||
| -rw-r--r-- | src/str_table.ads | 1 | ||||
| -rw-r--r-- | src/vhdl/evaluation.adb | 65 |
5 files changed, 109 insertions, 4 deletions
diff --git a/src/grt/grt-images.adb b/src/grt/grt-images.adb index c085380..272c423 100644 --- a/src/grt/grt-images.adb +++ b/src/grt/grt-images.adb @@ -242,13 +242,47 @@ package body Grt.Images is is Enum_Rti : Ghdl_Rtin_Type_Enum_Acc; Str : Ghdl_C_String; + Len : Natural; begin Enum_Rti := To_Ghdl_Rtin_Type_Enum_Acc (Rti); Str := Enum_Rti.Names (Index); if Str (1) = ''' then Return_String (Res, Str (2 .. 2)); else - Return_String (Res, Str (1 .. strlen (Str))); + Len := strlen (Str); + if Str (1) /= '\' then + Return_String (Res, Str (1 .. Len)); + else + -- Extended string. Compute length. + declare + Skip : Boolean; + Elen : Ghdl_Index_Type; + Epos : Ghdl_Index_Type; + begin + Skip := False; + Elen := 0; + for I in 2 .. Len - 1 loop + if Skip then + Skip := False; + else + Elen := Elen + 1; + Skip := Str (I) = '\'; + end if; + end loop; + Res.Base := To_Std_String_Basep (Ghdl_Stack2_Allocate (Elen)); + Epos := 0; + for I in 2 .. Len - 1 loop + if Skip then + Skip := False; + else + Res.Base (Epos) := Str (I); + Epos := Epos + 1; + Skip := Str (I) = '\'; + end if; + end loop; + Set_String_Bounds (Res, Elen); + end; + end if; end if; end To_String_Enum; diff --git a/src/name_table.ads b/src/name_table.ads index 0d6ff6b..e44e87f 100644 --- a/src/name_table.ads +++ b/src/name_table.ads @@ -21,6 +21,10 @@ with Types; use Types; -- A very simple name table. This is an hash table, so that -- id1 = id2 <=> get_string (id1) = get_string (id2). +-- Note: for VHDL, extended names are represented as they appear in the +-- sources: with a leading and trailing backslash; internal backslashes are +-- doubled. + package Name_Table is -- Initialize the package, ie create tables. procedure Initialize; diff --git a/src/str_table.adb b/src/str_table.adb index 4b4e15b..eeebea1 100644 --- a/src/str_table.adb +++ b/src/str_table.adb @@ -47,6 +47,13 @@ package body Str_Table is Append_String8 (Character'Pos (El)); end Append_String8_Char; + procedure Append_String8_String (S : String) is + begin + for I in S'Range loop + Append_String8_Char (S (I)); + end loop; + end Append_String8_String; + procedure Resize_String8 (Len : Nat32) is begin String8_Table.Set_Last (Cur_String8 + String8_Id (Len) - 1); diff --git a/src/str_table.ads b/src/str_table.ads index 1710367..0d815e6 100644 --- a/src/str_table.ads +++ b/src/str_table.ads @@ -34,6 +34,7 @@ package Str_Table is procedure Append_String8 (El : Nat8); procedure Append_String8_Char (El : Character); pragma Inline (Append_String8_Char); + procedure Append_String8_String (S : String); -- Resize (reduce or expand) the current string8. When expanded, new -- elements are uninitialized. diff --git a/src/vhdl/evaluation.adb b/src/vhdl/evaluation.adb index 9bcc85e..3ce2b2d 100644 --- a/src/vhdl/evaluation.adb +++ b/src/vhdl/evaluation.adb @@ -26,6 +26,9 @@ with Std_Names; with Ada.Characters.Handling; package body Evaluation is + function Eval_Enum_To_String (Lit : Iir; Orig : Iir) return Iir; + function Eval_Integer_Image (Val : Iir_Int64; Orig : Iir) return Iir; + function Get_Physical_Value (Expr : Iir) return Iir_Int64 is pragma Unsuppress (Overflow_Check); @@ -542,6 +545,12 @@ package body Evaluation is return Build_Simple_Aggregate (R_List, Orig, Get_Type (Operand)); end; + + when Iir_Predefined_Enum_To_String => + return Eval_Enum_To_String (Operand, Orig); + when Iir_Predefined_Integer_To_String => + return Eval_Integer_Image (Get_Value (Operand), Orig); + when others => Error_Internal (Orig, "eval_monadic_operator: " & Iir_Predefined_Functions'Image (Func)); @@ -1627,9 +1636,7 @@ package body Evaluation is Name : constant String := Image_Identifier (Lit); Image_Id : constant String8_Id := Str_Table.Create_String8; begin - for I in Name'range loop - Append_String8_Char (Name (I)); - end loop; + Append_String8_String (Name); return Build_String (Image_Id, Name'Length, Orig); end Eval_Enumeration_Image; @@ -1735,6 +1742,58 @@ package body Evaluation is end if; end Build_Physical_Value; + function Eval_Enum_To_String (Lit : Iir; Orig : Iir) return Iir + is + use Str_Table; + Id : constant Name_Id := Get_Identifier (Lit); + Image_Id : constant String8_Id := Str_Table.Create_String8; + Len : Natural; + begin + if Get_Base_Type (Get_Type (Lit)) = Character_Type_Definition then + -- LRM08 5.7 String representations + -- - For a given value of type CHARACTER, the string representation + -- contains one element that is the given value. + Append_String8 (Nat8 (Get_Enum_Pos (Lit))); + Len := 1; + elsif Is_Character (Id) then + -- LRM08 5.7 String representations + -- - For a given value of an enumeration type other than CHARACTER, + -- if the value is a character literal, the string representation + -- contains a single element that is the character literal; [...] + Append_String8_Char (Get_Character (Id)); + Len := 1; + else + -- LRM08 5.7 String representations + -- - [...] otherwise, the string representation is the sequence of + -- characters in the identifier that is the given value. + -- FIXME: extended identifier. + Image (Id); + if Nam_Buffer (1) /= '\' then + Append_String8_String (Nam_Buffer (1 .. Nam_Length)); + Len := Nam_Length; + else + declare + Skip : Boolean; + C : Character; + begin + Len := 0; + Skip := False; + for I in 2 .. Nam_Length - 1 loop + if Skip then + Skip := False; + else + C := Nam_Buffer (I); + Append_String8_Char (C); + Skip := C = '\'; + Len := Len + 1; + end if; + end loop; + end; + end if; + end if; + return Build_String (Image_Id, Nat32 (Len), Orig); + end Eval_Enum_To_String; + function Eval_Incdec (Expr : Iir; N : Iir_Int64; Origin : Iir) return Iir is P : Iir_Int64; |