From 17082aaf70426f2204b4259e45b1ca6e315bd439 Mon Sep 17 00:00:00 2001 From: Tristan Gingold Date: Mon, 29 Dec 2014 08:20:50 +0100 Subject: Rework string literals: store literals position. --- src/files_map.adb | 111 +++---- src/libraries.adb | 9 +- src/str_table.adb | 91 +++--- src/str_table.ads | 42 ++- src/types.ads | 18 +- src/vhdl/disp_tree.adb | 8 +- src/vhdl/disp_vhdl.adb | 40 +-- src/vhdl/errorout.adb | 8 +- src/vhdl/evaluation.adb | 235 ++++++--------- src/vhdl/iirs.adb | 67 ++--- src/vhdl/iirs.adb.in | 8 +- src/vhdl/iirs.ads | 75 ++--- src/vhdl/iirs_utils.adb | 17 +- src/vhdl/iirs_utils.ads | 4 - src/vhdl/nodes.ads | 6 +- src/vhdl/nodes_meta.adb | 576 +++++++++++++++++-------------------- src/vhdl/nodes_meta.ads | 18 +- src/vhdl/parse.adb | 58 ++-- src/vhdl/scanner.adb | 172 +++++------ src/vhdl/scanner.ads | 4 +- src/vhdl/sem.adb | 20 +- src/vhdl/sem_expr.adb | 98 ++++--- src/vhdl/sem_inst.adb | 4 +- src/vhdl/sem_names.adb | 3 +- src/vhdl/std_package.adb | 5 +- src/vhdl/translate/trans-chap2.adb | 2 +- src/vhdl/translate/trans-chap4.adb | 2 +- src/vhdl/translate/trans-chap7.adb | 97 ++----- src/vhdl/translate/translation.adb | 12 +- 29 files changed, 775 insertions(+), 1035 deletions(-) (limited to 'src') diff --git a/src/files_map.adb b/src/files_map.adb index 707152080..22c33e490 100644 --- a/src/files_map.adb +++ b/src/files_map.adb @@ -440,26 +440,25 @@ package body Files_Map is Second: Second_Type; begin GM_Split (Time, Year, Month, Day, Hour, Minute, Second); - Res := Time_Stamp_Id (Start); - Append (Digit_To_Char (Year / 1000)); - Append (Digit_To_Char (Year / 100)); - Append (Digit_To_Char (Year / 10)); - Append (Digit_To_Char (Year / 1)); - Append (Digit_To_Char (Month / 10)); - Append (Digit_To_Char (Month / 1)); - Append (Digit_To_Char (Day / 10)); - Append (Digit_To_Char (Day / 1)); - Append (Digit_To_Char (Hour / 10)); - Append (Digit_To_Char (Hour / 1)); - Append (Digit_To_Char (Minute / 10)); - Append (Digit_To_Char (Minute / 1)); - Append (Digit_To_Char (Second / 10)); - Append (Digit_To_Char (Second / 1)); - Append ('.'); - Append ('0'); - Append ('0'); - Append ('0'); - Finish; + Res := Time_Stamp_Id (Create_String8); + Append_String8_Char (Digit_To_Char (Year / 1000)); + Append_String8_Char (Digit_To_Char (Year / 100)); + Append_String8_Char (Digit_To_Char (Year / 10)); + Append_String8_Char (Digit_To_Char (Year / 1)); + Append_String8_Char (Digit_To_Char (Month / 10)); + Append_String8_Char (Digit_To_Char (Month / 1)); + Append_String8_Char (Digit_To_Char (Day / 10)); + Append_String8_Char (Digit_To_Char (Day / 1)); + Append_String8_Char (Digit_To_Char (Hour / 10)); + Append_String8_Char (Digit_To_Char (Hour / 1)); + Append_String8_Char (Digit_To_Char (Minute / 10)); + Append_String8_Char (Digit_To_Char (Minute / 1)); + Append_String8_Char (Digit_To_Char (Second / 10)); + Append_String8_Char (Digit_To_Char (Second / 1)); + Append_String8_Char ('.'); + Append_String8_Char ('0'); + Append_String8_Char ('0'); + Append_String8_Char ('0'); return Res; end Os_Time_To_Time_Stamp_Id; @@ -506,41 +505,40 @@ package body Files_Map is -- Use UTC time (like file time stamp). Split (Now_UTC, Year, Month, Day, Sec); - Res := Time_Stamp_Id (Start); - Append (Digit_To_Char (Year / 1000)); - Append (Digit_To_Char (Year / 100)); - Append (Digit_To_Char (Year / 10)); - Append (Digit_To_Char (Year / 1)); - Append (Digit_To_Char (Month / 10)); - Append (Digit_To_Char (Month / 1)); - Append (Digit_To_Char (Day / 10)); - Append (Digit_To_Char (Day / 1)); + Res := Time_Stamp_Id (Create_String8); + Append_String8_Char (Digit_To_Char (Year / 1000)); + Append_String8_Char (Digit_To_Char (Year / 100)); + Append_String8_Char (Digit_To_Char (Year / 10)); + Append_String8_Char (Digit_To_Char (Year / 1)); + Append_String8_Char (Digit_To_Char (Month / 10)); + Append_String8_Char (Digit_To_Char (Month / 1)); + Append_String8_Char (Digit_To_Char (Day / 10)); + Append_String8_Char (Digit_To_Char (Day / 1)); S := Integer (Sec); if Day_Duration (S) > Sec then -- We need a truncation. S := S - 1; end if; S1 := S / 3600; - Append (Digit_To_Char (S1 / 10)); - Append (Digit_To_Char (S1)); + Append_String8_Char (Digit_To_Char (S1 / 10)); + Append_String8_Char (Digit_To_Char (S1)); S1 := (S / 60) mod 60; - Append (Digit_To_Char (S1 / 10)); - Append (Digit_To_Char (S1)); + Append_String8_Char (Digit_To_Char (S1 / 10)); + Append_String8_Char (Digit_To_Char (S1)); S1 := S mod 60; - Append (Digit_To_Char (S1 / 10)); - Append (Digit_To_Char (S1)); + Append_String8_Char (Digit_To_Char (S1 / 10)); + Append_String8_Char (Digit_To_Char (S1)); - Append ('.'); + Append_String8_Char ('.'); Sec := Sec - Day_Duration (S); M := Integer (Sec * 1000); if M = 1000 then -- We need truncation. M := 999; end if; - Append (Digit_To_Char (M / 100)); - Append (Digit_To_Char (M / 10)); - Append (Digit_To_Char (M)); - Finish; + Append_String8_Char (Digit_To_Char (M / 100)); + Append_String8_Char (Digit_To_Char (M / 10)); + Append_String8_Char (Digit_To_Char (M)); return Res; end Get_Os_Time_Stamp; @@ -771,21 +769,32 @@ package body Files_Map is function Is_Eq (L : Time_Stamp_Id; R : Time_Stamp_Id) return Boolean is use Str_Table; - L_Str : constant String_Fat_Acc := Get_String_Fat_Acc (String_Id (L)); - R_Str : constant String_Fat_Acc := Get_String_Fat_Acc (String_Id (R)); + L_Str : constant String8_Id := String8_Id (L); + R_Str : constant String8_Id := String8_Id (R); begin - return L_Str (1 .. Time_Stamp_String'Length) - = R_Str (1 .. Time_Stamp_String'Length); + for I in 1 .. Nat32 (Time_Stamp_String'Length) loop + if Element_String8 (L_Str, I) /= Element_String8 (R_Str, I) then + return False; + end if; + end loop; + return True; end Is_Eq; function Is_Gt (L : Time_Stamp_Id; R : Time_Stamp_Id) return Boolean is use Str_Table; - L_Str : constant String_Fat_Acc := Get_String_Fat_Acc (String_Id (L)); - R_Str : constant String_Fat_Acc := Get_String_Fat_Acc (String_Id (R)); - begin - return L_Str (1 .. Time_Stamp_String'Length) - > R_Str (1 .. Time_Stamp_String'Length); + L_Str : constant String8_Id := String8_Id (L); + R_Str : constant String8_Id := String8_Id (R); + E_L, E_R : Nat8; + begin + for I in 1 .. Nat32 (Time_Stamp_String'Length) loop + E_L := Element_String8 (L_Str, I); + E_R := Element_String8 (R_Str, I); + if E_L /= E_R then + return E_L > E_R; + end if; + end loop; + return False; end Is_Gt; function Get_Time_Stamp_String (Ts : Time_Stamp_Id) return String is @@ -793,8 +802,8 @@ package body Files_Map is if Ts = Null_Time_Stamp then return "NULL_TS"; else - return String (Str_Table.Get_String_Fat_Acc (String_Id (Ts)) - (1 .. Time_Stamp_String'Length)); + return Str_Table.String_String8 + (String8_Id (Ts), Time_Stamp_String'Length); end if; end Get_Time_Stamp_String; diff --git a/src/libraries.adb b/src/libraries.adb index 9bc232740..83565463d 100644 --- a/src/libraries.adb +++ b/src/libraries.adb @@ -295,13 +295,12 @@ package body Libraries is function String_To_Name_Id return Name_Id is - Len : Int32; - Ptr : String_Fat_Acc; + Len : constant Nat32 := Current_String_Length; + Str_Id : constant String8_Id := Current_String_Id; begin - Len := Current_String_Length; - Ptr := Str_Table.Get_String_Fat_Acc (Current_String_Id); for I in 1 .. Len loop - Name_Table.Name_Buffer (Natural (I)) := Ptr (I); + Name_Table.Name_Buffer (Natural (I)) := + Str_Table.Char_String8 (Str_Id, I); end loop; Name_Table.Name_Length := Natural (Len); -- FIXME: should remove last string. diff --git a/src/str_table.adb b/src/str_table.adb index 32a44b58b..85f770015 100644 --- a/src/str_table.adb +++ b/src/str_table.adb @@ -15,78 +15,67 @@ -- along with GHDL; see the file COPYING. If not, write to the Free -- Software Foundation, 59 Temple Place - Suite 330, Boston, MA -- 02111-1307, USA. -with System; -with Ada.Unchecked_Conversion; with GNAT.Table; package body Str_Table is - package String_Table is new GNAT.Table - (Table_Index_Type => String_Id, - Table_Component_Type => Character, - Table_Low_Bound => Null_String + 1, - Table_Initial => 4096, + package String8_Table is new GNAT.Table + (Table_Index_Type => String8_Id, + Table_Component_Type => Nat8, + Table_Low_Bound => Null_String8 + 1, + Table_Initial => 1024, Table_Increment => 100); - Nul : constant Character := Character'Val (0); + Cur_String8 : String8_Id := 0; - In_String : Boolean := False; + function Create_String8 return String8_Id is + begin + Cur_String8 := String8_Table.Last + 1; + return Cur_String8; + end Create_String8; - function Start return String_Id is + procedure Append_String8 (El : Nat8) is begin - pragma Assert (In_String = False); - In_String := True; - return String_Table.Last + 1; - end Start; + String8_Table.Append (El); + end Append_String8; - procedure Append (C : Character) is + procedure Append_String8_Char (El : Character) is begin - pragma Assert (In_String); - String_Table.Append (C); - end Append; + Append_String8 (Character'Pos (El)); + end Append_String8_Char; - procedure Finish is + procedure Resize_String8 (Len : Nat32) is begin - pragma Assert (In_String); - String_Table.Append (Nul); - In_String := False; - end Finish; + String8_Table.Set_Last (Cur_String8 + String8_Id (Len) - 1); + end Resize_String8; - function Get_String_Fat_Acc (Id : String_Id) return String_Fat_Acc - is - function To_String_Fat_Acc is new Ada.Unchecked_Conversion - (Source => System.Address, Target => String_Fat_Acc); + function Element_String8 (Id : String8_Id; N : Pos32) return Nat8 is begin - return To_String_Fat_Acc (String_Table.Table (Id)'Address); - end Get_String_Fat_Acc; + return String8_Table.Table (Id + String8_Id (N - 1)); + end Element_String8; - function Get_Length (Id : String_Id) return Natural - is - Ptr : String_Fat_Acc; - Len : Nat32; + procedure Set_Element_String8 (Id : String8_Id; N : Pos32; Val : Nat8) is begin - Ptr := Get_String_Fat_Acc (Id); - Len := 1; - loop - if Ptr (Len) = Nul then - return Natural (Len - 1); - end if; - Len := Len + 1; - end loop; - end Get_Length; + String8_Table.Table (Id + String8_Id (N - 1)) := Val; + end Set_Element_String8; - function Image (Id : String_Id) return String + function Char_String8 (Id : String8_Id; N : Pos32) return Character is + begin + return Character'Val (Element_String8 (Id, N)); + end Char_String8; + + function String_String8 (Id : String8_Id; Len : Nat32) return String is - Ptr : String_Fat_Acc; - Len : Nat32; + Res : String (1 .. Natural (Len)); begin - Len := Nat32 (Get_Length (Id)); - Ptr := Get_String_Fat_Acc (Id); - return String (Ptr (1 .. Len)); - end Image; + for I in 1 .. Len loop + Res (Natural (I)) := Char_String8 (Id, I); + end loop; + return Res; + end String_String8; procedure Initialize is begin - String_Table.Free; - String_Table.Init; + String8_Table.Free; + String8_Table.Init; end Initialize; end Str_Table; diff --git a/src/str_table.ads b/src/str_table.ads index de65070e3..7be26560e 100644 --- a/src/str_table.ads +++ b/src/str_table.ads @@ -18,25 +18,37 @@ with Types; use Types; package Str_Table is - -- Create a new entry in the string table and returns a number to it. - function Start return String_Id; - pragma Inline (Start); + -- String8 are arrays (or strings) of Nat8 elements. They are used to + -- store analyzed string or bit string literals. The elements are the + -- position of literals, so it is possible to use them for enumerated types + -- containing at most 256 elements (which is the case of standard.bit and + -- std_logic_1164.std_ulogic). + -- It is not possible to free a string8. - -- Add a new character in the current entry. - procedure Append (C : Character); - pragma Inline (Append); + -- Create a new string8; this also close the previous string8. + -- Initial length is 0. + function Create_String8 return String8_Id; - -- Finish the current entry. - procedure Finish; - pragma Inline (Finish); + -- Append a new element to the being created string8. + procedure Append_String8 (El : Nat8); + procedure Append_String8_Char (El : Character); + pragma Inline (Append_String8_Char); - -- Get a fat access to the string ID. - function Get_String_Fat_Acc (Id : String_Id) return String_Fat_Acc; - pragma Inline (Get_String_Fat_Acc); + -- Resize (reduce or expand) the current string8. When expanded, new + -- elements are uninitialized. + procedure Resize_String8 (Len : Nat32); - -- Get ID as a string. - -- This function is slow, to be used only for debugging. - function Image (Id : String_Id) return String; + -- Get/Set N-th element of String8 ID. There is no bound checking. + function Element_String8 (Id : String8_Id; N : Pos32) return Nat8; + procedure Set_Element_String8 (Id : String8_Id; N : Pos32; Val : Nat8); + + -- Utility function: get N-th element of ID as a character. Valid only + -- if the elements of ID are Latin-1 codes. + function Char_String8 (Id : String8_Id; N : Pos32) return Character; + pragma Inline (Char_String8); + + -- Utility function: get the LEN elements as a string. + function String_String8 (Id : String8_Id; Len : Nat32) return String; -- Free all the memory and reinitialize the package. procedure Initialize; diff --git a/src/types.ads b/src/types.ads index 571e11b6a..2fa4b3ab8 100644 --- a/src/types.ads +++ b/src/types.ads @@ -30,6 +30,8 @@ package Types is subtype Nat32 is Int32 range 0 .. Int32'Last; subtype Pos32 is Nat32 range 1 .. Nat32'Last; + subtype Nat8 is Nat32 range 0 .. 255; + type Uns32 is new Interfaces.Unsigned_32; type Fp64 is new Interfaces.IEEE_Float_64; @@ -40,9 +42,6 @@ package Types is -- iir_int64 is aimed at containing units values. type Iir_Int64 is new Interfaces.Integer_64; - -- iir_fp32 is aimed at containing floating point values. - type Iir_Fp32 is new Interfaces.IEEE_Float_32; - -- iir_fp64 is aimed at containing floating point values. subtype Iir_Fp64 is Fp64; @@ -54,10 +53,6 @@ package Types is type String_Cst is access constant String; type String_Acc_Array is array (Natural range <>) of String_Acc; - type String_Fat is array (Pos32) of Character; - type String_Fat_Acc is access String_Fat; - pragma No_Strict_Aliasing (String_Fat_Acc); - -- Type of a name table element. -- The name table is defined in the name_table package. type Name_Id is new Nat32; @@ -66,11 +61,10 @@ package Types is -- It is sure that this entry is never allocated. Null_Identifier: constant Name_Id := 0; - -- Type of a string stored into the string table. - type String_Id is new Nat32; - for String_Id'Size use 32; + type String8_Id is new Nat32; + for String8_Id'Size use 32; - Null_String : constant String_Id := 0; + Null_String8 : constant String8_Id := 0; -- Index type is the source file table. -- This table is defined in the files_map package. @@ -114,7 +108,7 @@ package Types is -- String representing a date/time (format is YYYYMMDDHHmmSS.sss). subtype Time_Stamp_String is String (1 .. 18); - type Time_Stamp_Id is new String_Id; + type Time_Stamp_Id is new String8_Id; Null_Time_Stamp : constant Time_Stamp_Id := 0; -- Self-explaining: raised when an internal error (such as consistency) diff --git a/src/vhdl/disp_tree.adb b/src/vhdl/disp_tree.adb index ad3c19971..f8cc5d6c4 100644 --- a/src/vhdl/disp_tree.adb +++ b/src/vhdl/disp_tree.adb @@ -20,7 +20,6 @@ with Ada.Text_IO; use Ada.Text_IO; with Name_Table; -with Str_Table; with Tokens; with Errorout; with Files_Map; @@ -292,9 +291,6 @@ package body Disp_Tree is return Iir_Predefined_Functions'Image (F); end Image_Iir_Predefined_Functions; - function Image_String_Id (S : String_Id) return String - renames Str_Table.Image; - procedure Disp_PSL_Node (N : PSL_Node; Indent : Natural) is begin Put_Indent (Indent); @@ -406,8 +402,8 @@ package body Disp_Tree is Get_Field_Attribute (F) = Attr_Of_Ref); when Type_PSL_NFA => Disp_PSL_NFA (Get_PSL_NFA (N, F), Sub_Indent); - when Type_String_Id => - Put_Line (Image_String_Id (Get_String_Id (N, F))); + when Type_String8_Id => + Put_Line (""); when Type_PSL_Node => Disp_PSL_Node (Get_PSL_Node (N, F), Sub_Indent); when Type_Source_Ptr => diff --git a/src/vhdl/disp_vhdl.adb b/src/vhdl/disp_vhdl.adb index 90338af7d..b8ca9f400 100644 --- a/src/vhdl/disp_vhdl.adb +++ b/src/vhdl/disp_vhdl.adb @@ -26,6 +26,7 @@ with Flags; use Flags; with Errorout; use Errorout; with Iirs_Utils; use Iirs_Utils; with Name_Table; +with Str_Table; with Std_Names; with Tokens; with PSL.Nodes; @@ -2372,7 +2373,7 @@ package body Disp_Vhdl is Assoc := Get_Chain (Assoc); end if; if Get_Kind (Expr) = Iir_Kind_Aggregate - or else Get_Kind (Expr) = Iir_Kind_String_Literal then + or else Get_Kind (Expr) = Iir_Kind_String_Literal8 then Set_Col (Indent); end if; Disp_Expression (Expr); @@ -2440,14 +2441,22 @@ package body Disp_Vhdl is procedure Disp_String_Literal (Str : Iir) is - Ptr : constant String_Fat_Acc := Get_String_Fat_Acc (Str); - Len : constant Int32 := Get_String_Length (Str); + Id : constant String8_Id := Get_String8_Id (Str); + Len : constant Nat32 := Get_String_Length (Str); + El_Type : constant Iir := Get_Element_Subtype (Get_Type (Str)); + Literal_List : constant Iir_List := + Get_Enumeration_Literal_List (Get_Base_Type (El_Type)); + Lit : Iir; + C : Character; begin for I in 1 .. Len loop - if Ptr (I) = '"' then + Lit := Get_Nth_Element + (Literal_List, Natural (Str_Table.Element_String8 (Id, Pos32 (I)))); + C := Character'Val (Get_Enum_Pos (Lit)); + if C = '"' then Put ('"'); end if; - Put (Ptr (I)); + Put (C); end loop; end Disp_String_Literal; @@ -2470,7 +2479,7 @@ package body Disp_Vhdl is else Disp_Fp64 (Get_Fp_Value (Expr)); end if; - when Iir_Kind_String_Literal => + when Iir_Kind_String_Literal8 => Orig := Get_Literal_Origin (Expr); if Orig /= Null_Iir then Disp_Expression (Orig); @@ -2484,25 +2493,6 @@ package body Disp_Vhdl is Put ("]"); end if; end if; - when Iir_Kind_Bit_String_Literal => - Orig := Get_Literal_Origin (Expr); - if Orig /= Null_Iir then - Disp_Expression (Orig); - else - if False then - case Get_Bit_String_Base (Expr) is - when Base_2 => - Put ('B'); - when Base_8 => - Put ('O'); - when Base_16 => - Put ('X'); - end case; - end if; - Put ("B"""); - Disp_String_Literal (Expr); - Put (""""); - end if; when Iir_Kind_Physical_Fp_Literal | Iir_Kind_Physical_Int_Literal => Orig := Get_Literal_Origin (Expr); diff --git a/src/vhdl/errorout.adb b/src/vhdl/errorout.adb index b78bfc2d2..940b8fc91 100644 --- a/src/vhdl/errorout.adb +++ b/src/vhdl/errorout.adb @@ -375,12 +375,8 @@ package body Errorout is begin case Get_Kind (Node) is - when Iir_Kind_String_Literal => - return "string literal """ - & Image_String_Lit (Node) & """"; - when Iir_Kind_Bit_String_Literal => - return "bit string literal """ - & Image_String_Lit (Node) & """"; + when Iir_Kind_String_Literal8 => + return "string literal"; when Iir_Kind_Character_Literal => return "character literal " & Image_Identifier (Node); when Iir_Kind_Integer_Literal => diff --git a/src/vhdl/evaluation.adb b/src/vhdl/evaluation.adb index bf9c6ba3f..4093b9460 100644 --- a/src/vhdl/evaluation.adb +++ b/src/vhdl/evaluation.adb @@ -133,14 +133,14 @@ package body Evaluation is end case; end Build_Discrete; - function Build_String (Val : String_Id; Len : Nat32; Origin : Iir) - return Iir_String_Literal + function Build_String (Val : String8_Id; Len : Nat32; Origin : Iir) + return Iir is - Res : Iir_String_Literal; + Res : Iir; begin - Res := Create_Iir (Iir_Kind_String_Literal); + Res := Create_Iir (Iir_Kind_String_Literal8); Location_Copy (Res, Origin); - Set_String_Id (Res, Val); + Set_String8_Id (Res, Val); Set_String_Length (Res, Len); Set_Type (Res, Get_Type (Origin)); Set_Literal_Origin (Res, Origin); @@ -206,18 +206,10 @@ package body Evaluation is Set_Value (Res, Get_Physical_Value (Val)); Set_Unit_Name (Res, Get_Primary_Unit_Name (Get_Type (Val))); - when Iir_Kind_String_Literal => - Res := Create_Iir (Iir_Kind_String_Literal); - Set_String_Id (Res, Get_String_Id (Val)); - Set_String_Length (Res, Get_String_Length (Val)); - - when Iir_Kind_Bit_String_Literal => - Res := Create_Iir (Iir_Kind_Bit_String_Literal); - Set_String_Id (Res, Get_String_Id (Val)); + when Iir_Kind_String_Literal8 => + Res := Create_Iir (Iir_Kind_String_Literal8); + Set_String8_Id (Res, Get_String8_Id (Val)); Set_String_Length (Res, Get_String_Length (Val)); - Set_Bit_String_Base (Res, Get_Bit_String_Base (Val)); - Set_Bit_String_0 (Res, Get_Bit_String_0 (Val)); - Set_Bit_String_1 (Res, Get_Bit_String_1 (Val)); when Iir_Kind_Simple_Aggregate => Res := Create_Iir (Iir_Kind_Simple_Aggregate); @@ -446,60 +438,35 @@ package body Evaluation is function Eval_String_Literal (Str : Iir) return Iir is - Ptr : String_Fat_Acc; Len : Nat32; begin case Get_Kind (Str) is - when Iir_Kind_String_Literal => + when Iir_Kind_String_Literal8 => declare Element_Type : Iir; Literal_List : Iir_List; Lit : Iir; List : Iir_List; + Id : String8_Id; begin Element_Type := Get_Base_Type (Get_Element_Subtype (Get_Base_Type (Get_Type (Str)))); Literal_List := Get_Enumeration_Literal_List (Element_Type); List := Create_Iir_List; - Ptr := Get_String_Fat_Acc (Str); + Id := Get_String8_Id (Str); Len := Get_String_Length (Str); for I in 1 .. Len loop - Lit := Find_Name_In_List + Lit := Get_Nth_Element (Literal_List, - Name_Table.Get_Identifier (Ptr (I))); + Natural (Str_Table.Element_String8 (Id, I))); Append_Element (List, Lit); end loop; return Build_Simple_Aggregate (List, Str, Get_Type (Str)); end; - when Iir_Kind_Bit_String_Literal => - declare - Str_Type : constant Iir := Get_Type (Str); - List : Iir_List; - Lit_0 : constant Iir := Get_Bit_String_0 (Str); - Lit_1 : constant Iir := Get_Bit_String_1 (Str); - begin - List := Create_Iir_List; - - Ptr := Get_String_Fat_Acc (Str); - Len := Get_String_Length (Str); - - for I in 1 .. Len loop - case Ptr (I) is - when '0' => - Append_Element (List, Lit_0); - when '1' => - Append_Element (List, Lit_1); - when others => - raise Internal_Error; - end case; - end loop; - return Build_Simple_Aggregate (List, Str, Str_Type); - end; - when Iir_Kind_Simple_Aggregate => return Str; @@ -591,10 +558,10 @@ package body Evaluation is return Iir is use Str_Table; - L_Str : constant String_Fat_Acc := Get_String_Fat_Acc (Left); - R_Str : constant String_Fat_Acc := Get_String_Fat_Acc (Right); + L_Str : constant String8_Id := Get_String8_Id (Left); + R_Str : constant String8_Id := Get_String8_Id (Right); Len : Nat32; - Id : String_Id; + Id : String8_Id; Res : Iir; begin Len := Get_String_Length (Left); @@ -602,30 +569,30 @@ package body Evaluation is Warning_Msg_Sem ("length of left and right operands mismatch", Expr); return Build_Overflow (Expr); else - Id := Start; + Id := Create_String8; case Func is when Iir_Predefined_TF_Array_And => for I in 1 .. Len loop - case L_Str (I) is - when '0' => - Append ('0'); - when '1' => - Append (R_Str (I)); + case Element_String8 (L_Str, I) is + when 0 => + Append_String8 (0); + when 1 => + Append_String8 (Element_String8 (R_Str, I)); when others => raise Internal_Error; end case; end loop; when Iir_Predefined_TF_Array_Nand => for I in 1 .. Len loop - case L_Str (I) is - when '0' => - Append ('1'); - when '1' => - case R_Str (I) is - when '0' => - Append ('1'); - when '1' => - Append ('0'); + case Element_String8 (L_Str, I) is + when 0 => + Append_String8 (1); + when 1 => + case Element_String8 (R_Str, I) is + when 0 => + Append_String8 (1); + when 1 => + Append_String8 (0); when others => raise Internal_Error; end case; @@ -635,26 +602,26 @@ package body Evaluation is end loop; when Iir_Predefined_TF_Array_Or => for I in 1 .. Len loop - case L_Str (I) is - when '1' => - Append ('1'); - when '0' => - Append (R_Str (I)); + case Element_String8 (L_Str, I) is + when 1 => + Append_String8 (1); + when 0 => + Append_String8 (Element_String8 (R_Str, I)); when others => raise Internal_Error; end case; end loop; when Iir_Predefined_TF_Array_Nor => for I in 1 .. Len loop - case L_Str (I) is - when '1' => - Append ('0'); - when '0' => - case R_Str (I) is - when '0' => - Append ('1'); - when '1' => - Append ('0'); + case Element_String8 (L_Str, I) is + when 1 => + Append_String8 (0); + when 0 => + case Element_String8 (R_Str, I) is + when 0 => + Append_String8 (1); + when 1 => + Append_String8 (0); when others => raise Internal_Error; end case; @@ -664,25 +631,18 @@ package body Evaluation is end loop; when Iir_Predefined_TF_Array_Xor => for I in 1 .. Len loop - case L_Str (I) is - when '1' => - case R_Str (I) is - when '0' => - Append ('1'); - when '1' => - Append ('0'); - when others => - raise Internal_Error; - end case; - when '0' => - case R_Str (I) is - when '0' => - Append ('0'); - when '1' => - Append ('1'); + case Element_String8 (L_Str, I) is + when 1 => + case Element_String8 (R_Str, I) is + when 0 => + Append_String8 (1); + when 1 => + Append_String8 (0); when others => raise Internal_Error; end case; + when 0 => + Append_String8 (Element_String8 (R_Str, I)); when others => raise Internal_Error; end case; @@ -691,7 +651,6 @@ package body Evaluation is Error_Internal (Expr, "eval_dyadic_bit_array_functions: " & Iir_Predefined_Functions'Image (Func)); end case; - Finish; Res := Build_String (Id, Len, Expr); -- The unconstrained type is replaced by the constrained one. @@ -1451,7 +1410,7 @@ package body Evaluation is Img : String (1 .. 24); -- 23 is enough, 24 is rounded. L : Natural; V : Iir_Int64; - Id : String_Id; + Id : String8_Id; begin V := Val; L := Img'Last; @@ -1465,18 +1424,17 @@ package body Evaluation is Img (L) := '-'; L := L - 1; end if; - Id := Start; + Id := Create_String8; for I in L + 1 .. Img'Last loop - Append (Img (I)); + Append_String8_Char (Img (I)); end loop; - Finish; - return Build_String (Id, Int32 (Img'Last - L), Orig); + return Build_String (Id, Nat32 (Img'Last - L), Orig); end Eval_Integer_Image; function Eval_Floating_Image (Val : Iir_Fp64; Orig : Iir) return Iir is use Str_Table; - Id : String_Id; + Id : String8_Id; -- Sign (1) + digit (1) + dot (1) + digits (15) + exp (1) + sign (1) -- + exp_digits (4) -> 24. @@ -1560,11 +1518,10 @@ package body Evaluation is end loop; end if; - Id := Start; + Id := Create_String8; for I in 1 .. P loop - Append (Str (I)); + Append_String8_Char (Str (I)); end loop; - Finish; Res := Build_String (Id, Int32 (P), Orig); -- FIXME: this is not correct since the type is *not* constrained. Set_Type (Res, Create_Unidim_Array_By_Length @@ -1574,13 +1531,13 @@ package body Evaluation is function Eval_Enumeration_Image (Lit : Iir; Orig : Iir) return Iir is + use Str_Table; Name : constant String := Image_Identifier (Lit); - Image_Id : constant String_Id := Str_Table.Start; + Image_Id : constant String8_Id := Str_Table.Create_String8; begin for I in Name'range loop - Str_Table.Append (Name (I)); + Append_String8_Char (Name (I)); end loop; - Str_Table.Finish; return Build_String (Image_Id, Name'Length, Orig); end Eval_Enumeration_Image; @@ -1608,22 +1565,21 @@ package body Evaluation is Unit : constant Iir := Get_Primary_Unit (Get_Base_Type (Get_Type (Phys))); UnitName : constant String := Image_Identifier (Unit); - Image_Id : constant String_Id := Str_Table.Start; + Image_Id : constant String8_Id := Str_Table.Create_String8; Length : Nat32 := Value'Length + UnitName'Length + 1; begin for I in Value'range loop -- Suppress the Ada +ve integer'image leading space if I > Value'first or else Value (I) /= ' ' then - Str_Table.Append (Value (I)); + Str_Table.Append_String8_Char (Value (I)); else Length := Length - 1; end if; end loop; - Str_Table.Append (' '); + Str_Table.Append_String8_Char (' '); for I in UnitName'range loop - Str_Table.Append (UnitName (I)); + Str_Table.Append_String8_Char (UnitName (I)); end loop; - Str_Table.Finish; return Build_String (Image_Id, Length, Expr); end Eval_Physical_Image; @@ -1864,8 +1820,7 @@ package body Evaluation is when Iir_Kind_Integer_Literal | Iir_Kind_Enumeration_Literal | Iir_Kind_Floating_Point_Literal - | Iir_Kind_String_Literal - | Iir_Kind_Bit_String_Literal + | Iir_Kind_String_Literal8 | Iir_Kind_Overflow_Literal | Iir_Kind_Physical_Int_Literal | Iir_Kind_Physical_Fp_Literal => @@ -2011,7 +1966,7 @@ package body Evaluation is Param := Get_Parameter (Expr); Param := Eval_Static_Expr (Param); Set_Parameter (Expr, Param); - if Get_Kind (Param) /= Iir_Kind_String_Literal then + if Get_Kind (Param) /= Iir_Kind_String_Literal8 then -- FIXME: Isn't it an implementation restriction. Warning_Msg_Sem ("'value argument not a string", Expr); return Build_Overflow (Expr); @@ -2145,14 +2100,13 @@ package body Evaluation is when Iir_Kind_Simple_Name_Attribute => declare use Str_Table; - Id : String_Id; + Id : String8_Id; begin - Id := Start; + Id := Create_String8; Image (Get_Simple_Name_Identifier (Expr)); for I in 1 .. Name_Length loop - Append (Name_Buffer (I)); + Append_String8_Char (Name_Buffer (I)); end loop; - Finish; return Build_String (Id, Nat32 (Name_Length), Expr); end; @@ -2732,10 +2686,8 @@ package body Evaluation is is type Str_Info is record El : Iir; - Ptr : String_Fat_Acc; + Id : String8_Id; Len : Nat32; - Lit_0 : Iir; - Lit_1 : Iir; List : Iir_List; end record; @@ -2747,23 +2699,14 @@ package body Evaluation is case Get_Kind (Expr) is when Iir_Kind_Simple_Aggregate => Res := Str_Info'(El => Expr, - Ptr => null, + Id => Null_String8, Len => 0, - Lit_0 | Lit_1 => Null_Iir, List => Get_Simple_Aggregate_List (Expr)); Res.Len := Nat32 (Get_Nbr_Elements (Res.List)); - when Iir_Kind_Bit_String_Literal => - Res := Str_Info'(El => Expr, - Ptr => Get_String_Fat_Acc (Expr), - Len => Get_String_Length (Expr), - Lit_0 => Get_Bit_String_0 (Expr), - Lit_1 => Get_Bit_String_1 (Expr), - List => Null_Iir_List); - when Iir_Kind_String_Literal => + when Iir_Kind_String_Literal8 => Res := Str_Info'(El => Expr, - Ptr => Get_String_Fat_Acc (Expr), + Id => Get_String8_Id (Expr), Len => Get_String_Length (Expr), - Lit_0 | Lit_1 => Null_Iir, List => Null_Iir_List); when others => Error_Kind ("sem_string_choice_range.get_info", Expr); @@ -2774,30 +2717,14 @@ package body Evaluation is function Get_Pos (Str : Str_Info; Idx : Nat32) return Iir_Int32 is S : Iir; - C : Character; + P : Nat32; begin case Get_Kind (Str.El) is when Iir_Kind_Simple_Aggregate => S := Get_Nth_Element (Str.List, Natural (Idx)); - when Iir_Kind_String_Literal => - C := Str.Ptr (Idx + 1); - -- FIXME: build a table from character to position. - -- This linear search is O(n)! - S := Find_Name_In_List (Literal_List, - Name_Table.Get_Identifier (C)); - if S = Null_Iir then - return -1; - end if; - when Iir_Kind_Bit_String_Literal => - C := Str.Ptr (Idx + 1); - case C is - when '0' => - S := Str.Lit_0; - when '1' => - S := Str.Lit_1; - when others => - raise Internal_Error; - end case; + when Iir_Kind_String_Literal8 => + P := Str_Table.Element_String8 (Str.Id, Idx + 1); + S := Get_Nth_Element (Literal_List, Natural (P)); when others => Error_Kind ("sem_string_choice_range.get_pos", Str.El); end case; diff --git a/src/vhdl/iirs.adb b/src/vhdl/iirs.adb index 37f73c65c..1462bb371 100644 --- a/src/vhdl/iirs.adb +++ b/src/vhdl/iirs.adb @@ -213,10 +213,10 @@ package body Iirs is function Iir_Signal_Kind_To_Boolean is new Ada.Unchecked_Conversion (Source => Iir_Signal_Kind, Target => Boolean); - function Iir_To_String_Id is new Ada.Unchecked_Conversion - (Source => Iir, Target => String_Id); - function String_Id_To_Iir is new Ada.Unchecked_Conversion - (Source => String_Id, Target => Iir); + function Iir_To_String8_Id is new Ada.Unchecked_Conversion + (Source => Iir, Target => String8_Id); + function String8_Id_To_Iir is new Ada.Unchecked_Conversion + (Source => String8_Id, Target => Iir); function Iir_To_Int32 is new Ada.Unchecked_Conversion (Source => Iir, Target => Int32); @@ -244,7 +244,7 @@ package body Iirs is | Iir_Kind_Library_Clause | Iir_Kind_Use_Clause | Iir_Kind_Null_Literal - | Iir_Kind_String_Literal + | Iir_Kind_String_Literal8 | Iir_Kind_Simple_Aggregate | Iir_Kind_Overflow_Literal | Iir_Kind_Waveform_Element @@ -436,7 +436,6 @@ package body Iirs is return Format_Short; when Iir_Kind_Design_File | Iir_Kind_Design_Unit - | Iir_Kind_Bit_String_Literal | Iir_Kind_Block_Header | Iir_Kind_Binding_Indication | Iir_Kind_Signature @@ -890,58 +889,30 @@ package body Iirs is begin pragma Assert (Target /= Null_Iir); pragma Assert (Has_Simple_Aggregate_List (Get_Kind (Target))); - return Iir_To_Iir_List (Get_Field3 (Target)); + return Iir_To_Iir_List (Get_Field4 (Target)); end Get_Simple_Aggregate_List; procedure Set_Simple_Aggregate_List (Target : Iir; List : Iir_List) is begin pragma Assert (Target /= Null_Iir); pragma Assert (Has_Simple_Aggregate_List (Get_Kind (Target))); - Set_Field3 (Target, Iir_List_To_Iir (List)); + Set_Field4 (Target, Iir_List_To_Iir (List)); end Set_Simple_Aggregate_List; function Get_Bit_String_Base (Lit : Iir) return Base_Type is begin pragma Assert (Lit /= Null_Iir); pragma Assert (Has_Bit_String_Base (Get_Kind (Lit))); - return Base_Type'Val (Get_Field8 (Lit)); + return Base_Type'Val (Get_State2 (Lit)); end Get_Bit_String_Base; procedure Set_Bit_String_Base (Lit : Iir; Base : Base_Type) is begin pragma Assert (Lit /= Null_Iir); pragma Assert (Has_Bit_String_Base (Get_Kind (Lit))); - Set_Field8 (Lit, Base_Type'Pos (Base)); + Set_State2 (Lit, Base_Type'Pos (Base)); end Set_Bit_String_Base; - function Get_Bit_String_0 (Lit : Iir) return Iir is - begin - pragma Assert (Lit /= Null_Iir); - pragma Assert (Has_Bit_String_0 (Get_Kind (Lit))); - return Get_Field6 (Lit); - end Get_Bit_String_0; - - procedure Set_Bit_String_0 (Lit : Iir; El : Iir) is - begin - pragma Assert (Lit /= Null_Iir); - pragma Assert (Has_Bit_String_0 (Get_Kind (Lit))); - Set_Field6 (Lit, El); - end Set_Bit_String_0; - - function Get_Bit_String_1 (Lit : Iir) return Iir is - begin - pragma Assert (Lit /= Null_Iir); - pragma Assert (Has_Bit_String_1 (Get_Kind (Lit))); - return Get_Field7 (Lit); - end Get_Bit_String_1; - - procedure Set_Bit_String_1 (Lit : Iir; El : Iir) is - begin - pragma Assert (Lit /= Null_Iir); - pragma Assert (Has_Bit_String_1 (Get_Kind (Lit))); - Set_Field7 (Lit, El); - end Set_Bit_String_1; - function Get_Literal_Origin (Lit : Iir) return Iir is begin pragma Assert (Lit /= Null_Iir); @@ -974,14 +945,14 @@ package body Iirs is begin pragma Assert (Lit /= Null_Iir); pragma Assert (Has_Literal_Subtype (Get_Kind (Lit))); - return Get_Field5 (Lit); + return Get_Field3 (Lit); end Get_Literal_Subtype; procedure Set_Literal_Subtype (Lit : Iir; Atype : Iir) is begin pragma Assert (Lit /= Null_Iir); pragma Assert (Has_Literal_Subtype (Get_Kind (Lit))); - Set_Field5 (Lit, Atype); + Set_Field3 (Lit, Atype); end Set_Literal_Subtype; function Get_Entity_Class (Target : Iir) return Token_Type is @@ -4240,19 +4211,19 @@ package body Iirs is Set_Field6 (Target, Location_Type_To_Iir (Loc)); end Set_End_Location; - function Get_String_Id (Lit : Iir) return String_Id is + function Get_String8_Id (Lit : Iir) return String8_Id is begin pragma Assert (Lit /= Null_Iir); - pragma Assert (Has_String_Id (Get_Kind (Lit))); - return Iir_To_String_Id (Get_Field3 (Lit)); - end Get_String_Id; + pragma Assert (Has_String8_Id (Get_Kind (Lit))); + return Iir_To_String8_Id (Get_Field5 (Lit)); + end Get_String8_Id; - procedure Set_String_Id (Lit : Iir; Id : String_Id) is + procedure Set_String8_Id (Lit : Iir; Id : String8_Id) is begin pragma Assert (Lit /= Null_Iir); - pragma Assert (Has_String_Id (Get_Kind (Lit))); - Set_Field3 (Lit, String_Id_To_Iir (Id)); - end Set_String_Id; + pragma Assert (Has_String8_Id (Get_Kind (Lit))); + Set_Field5 (Lit, String8_Id_To_Iir (Id)); + end Set_String8_Id; function Get_String_Length (Lit : Iir) return Int32 is begin diff --git a/src/vhdl/iirs.adb.in b/src/vhdl/iirs.adb.in index d8e8bc0e4..481a35542 100644 --- a/src/vhdl/iirs.adb.in +++ b/src/vhdl/iirs.adb.in @@ -213,10 +213,10 @@ package body Iirs is function Iir_Signal_Kind_To_Boolean is new Ada.Unchecked_Conversion (Source => Iir_Signal_Kind, Target => Boolean); - function Iir_To_String_Id is new Ada.Unchecked_Conversion - (Source => Iir, Target => String_Id); - function String_Id_To_Iir is new Ada.Unchecked_Conversion - (Source => String_Id, Target => Iir); + function Iir_To_String8_Id is new Ada.Unchecked_Conversion + (Source => Iir, Target => String8_Id); + function String8_Id_To_Iir is new Ada.Unchecked_Conversion + (Source => String8_Id, Target => Iir); function Iir_To_Int32 is new Ada.Unchecked_Conversion (Source => Iir, Target => Int32); diff --git a/src/vhdl/iirs.ads b/src/vhdl/iirs.ads index 2ce529ff0..6d3c45ae8 100644 --- a/src/vhdl/iirs.ads +++ b/src/vhdl/iirs.ads @@ -268,8 +268,7 @@ package Iirs is -- Literals -- --------------- - -- Iir_Kind_String_Literal (Short) - -- Iir_Kind_Bit_String_Literal (Medium) + -- Iir_Kind_String_Literal8 (Short) -- -- Get/Set_Type (Field1) -- @@ -277,26 +276,15 @@ package Iirs is -- whose value was computed during analysis and replaces the expression. -- Get/Set_Literal_Origin (Field2) -- - -- Get/Set_String_Id (Field3) + -- Same as Type, but marked as property of that node. + -- Get/Set_Literal_Subtype (Field3) -- - -- As bit-strings are expanded to '0'/'1' strings, this is the number of - -- characters. + -- Number of literals in the expanded string. -- Get/Set_String_Length (Field4) -- - -- Same as Type, but marked as property of that node. - -- Get/Set_Literal_Subtype (Field5) - -- - -- For bit string only: - -- Enumeration literal which correspond to '0' and '1'. - -- This cannot be defined only in the enumeration type definition, due to - -- possible aliases. - -- Only for Iir_Kind_Bit_String_Literal: - -- Get/Set_Bit_String_0 (Field6) - -- Only for Iir_Kind_Bit_String_Literal: - -- Get/Set_Bit_String_1 (Field7) + -- Get/Set_String8_Id (Field5) -- - -- Only for Iir_Kind_Bit_String_Literal: - -- Get/Set_Bit_String_Base (Field8) + -- Get/Set_Bit_String_Base (State2) -- -- Get/Set_Expr_Staticness (State1) @@ -358,13 +346,13 @@ package Iirs is -- -- Get/Set_Literal_Origin (Field2) -- - -- Get/Set_Expr_Staticness (State1) + -- Same as Type, but marked as property of that node. + -- Get/Set_Literal_Subtype (Field3) -- -- List of elements - -- Get/Set_Simple_Aggregate_List (Field3) + -- Get/Set_Simple_Aggregate_List (Field4) -- - -- Same as Type, but marked as property of that node. - -- Get/Set_Literal_Subtype (Field5) + -- Get/Set_Expr_Staticness (State1) -- Iir_Kind_Overflow_Literal (Short) -- This node can only be generated by evaluation to represent an error: out @@ -2888,10 +2876,10 @@ package Iirs is -- -- Get/Set_Aggregate_Info (Field2) -- - -- Get/Set_Association_Choices_Chain (Field4) - -- -- Same as Type, but marked as property of that node. - -- Get/Set_Literal_Subtype (Field5) + -- Get/Set_Literal_Subtype (Field3) + -- + -- Get/Set_Association_Choices_Chain (Field4) -- -- Get/Set_Expr_Staticness (State1) -- @@ -3355,10 +3343,9 @@ package Iirs is Iir_Kind_Integer_Literal, Iir_Kind_Floating_Point_Literal, Iir_Kind_Null_Literal, - Iir_Kind_String_Literal, + Iir_Kind_String_Literal8, Iir_Kind_Physical_Int_Literal, Iir_Kind_Physical_Fp_Literal, - Iir_Kind_Bit_String_Literal, Iir_Kind_Simple_Aggregate, Iir_Kind_Overflow_Literal, @@ -4095,10 +4082,9 @@ package Iirs is Iir_Kind_Integer_Literal .. --Iir_Kind_Floating_Point_Literal --Iir_Kind_Null_Literal - --Iir_Kind_String_Literal + --Iir_Kind_String_Literal8 --Iir_Kind_Physical_Int_Literal - --Iir_Kind_Physical_Fp_Literal - Iir_Kind_Bit_String_Literal; + Iir_Kind_Physical_Fp_Literal; subtype Iir_Kinds_Array_Type_Definition is Iir_Kind range Iir_Kind_Array_Type_Definition .. @@ -4593,7 +4579,7 @@ package Iirs is -- Purity depth of an impure subprogram. Iir_Depth_Impure : constant Iir_Int32 := -1; - type Base_Type is (Base_2, Base_8, Base_16); + type Base_Type is (Base_None, Base_2, Base_8, Base_16); -- design file subtype Iir_Design_File is Iir; @@ -4611,10 +4597,6 @@ package Iirs is subtype Iir_Floating_Point_Literal is Iir; - subtype Iir_String_Literal is Iir; - - subtype Iir_Bit_String_Literal is Iir; - subtype Iir_Null_Literal is Iir; subtype Iir_Physical_Int_Literal is Iir; @@ -5042,24 +5024,15 @@ package Iirs is procedure Set_Fp_Value (Lit : Iir; Val : Iir_Fp64); -- List of elements of a simple aggregate. - -- Field: Field3 (uc) + -- Field: Field4 (uc) function Get_Simple_Aggregate_List (Target : Iir) return Iir_List; procedure Set_Simple_Aggregate_List (Target : Iir; List : Iir_List); - -- The logarithm of the base (1, 3 or 4) of a bit string. - -- Field: Field8 (pos) + -- Base of a bit string. + -- Field: State2 (pos) function Get_Bit_String_Base (Lit : Iir) return Base_Type; procedure Set_Bit_String_Base (Lit : Iir; Base : Base_Type); - -- The enumeration literal which defines the '0' and '1' value. - -- Field: Field6 - function Get_Bit_String_0 (Lit : Iir) return Iir; - procedure Set_Bit_String_0 (Lit : Iir; El : Iir); - - -- Field: Field7 - function Get_Bit_String_1 (Lit : Iir) return Iir; - procedure Set_Bit_String_1 (Lit : Iir; El : Iir); - -- The origin of a literal can be null_iir for a literal generated by the -- parser, or a node which was statically evaluated to this literal. -- Such nodes are created by eval_expr. @@ -5074,7 +5047,7 @@ package Iirs is -- Same as Type, but not marked as Ref. This is when a literal has a -- subtype (such as string or bit_string) created specially for the -- literal. - -- Field: Field5 + -- Field: Field3 function Get_Literal_Subtype (Lit : Iir) return Iir; procedure Set_Literal_Subtype (Lit : Iir; Atype : Iir); @@ -6260,9 +6233,9 @@ package Iirs is procedure Set_End_Location (Target : Iir; Loc : Location_Type); -- For a string literal: the string identifier. - -- Field: Field3 (uc) - function Get_String_Id (Lit : Iir) return String_Id; - procedure Set_String_Id (Lit : Iir; Id : String_Id); + -- Field: Field5 (uc) + function Get_String8_Id (Lit : Iir) return String8_Id; + procedure Set_String8_Id (Lit : Iir; Id : String8_Id); -- For a string literal: the string length. -- Field: Field4 (uc) diff --git a/src/vhdl/iirs_utils.adb b/src/vhdl/iirs_utils.adb index 2d84983c1..99737c428 100644 --- a/src/vhdl/iirs_utils.adb +++ b/src/vhdl/iirs_utils.adb @@ -387,25 +387,16 @@ package body Iirs_Utils is end if; end Clear_Instantiation_Configuration; - function Get_String_Fat_Acc (Str : Iir) return String_Fat_Acc is - begin - return Str_Table.Get_String_Fat_Acc (Get_String_Id (Str)); - end Get_String_Fat_Acc; - -- Get identifier of NODE as a string. function Image_Identifier (Node : Iir) return String is begin return Name_Table.Image (Iirs.Get_Identifier (Node)); end Image_Identifier; - function Image_String_Lit (Str : Iir) return String - is - Ptr : String_Fat_Acc; - Len : Nat32; + function Image_String_Lit (Str : Iir) return String is begin - Ptr := Get_String_Fat_Acc (Str); - Len := Get_String_Length (Str); - return String (Ptr (1 .. Len)); + return Str_Table.String_String8 + (Get_String8_Id (Str), Get_String_Length (Str)); end Image_String_Lit; function Copy_Enumeration_Literal (Lit : Iir) return Iir @@ -455,7 +446,7 @@ package body Iirs_Utils is case Get_Kind (N) is when Iir_Kind_Simple_Name | Iir_Kind_Character_Literal - | Iir_Kind_String_Literal + | Iir_Kind_String_Literal8 | Iir_Kind_Subtype_Definition => Free_Iir (N); when Iir_Kind_Selected_Name diff --git a/src/vhdl/iirs_utils.ads b/src/vhdl/iirs_utils.ads index da3e72b93..3d74aa30d 100644 --- a/src/vhdl/iirs_utils.ads +++ b/src/vhdl/iirs_utils.ads @@ -27,10 +27,6 @@ package Iirs_Utils is function Image_Identifier (Node : Iir) return String; function Image_String_Lit (Str : Iir) return String; - -- Easier function for string literals. - function Get_String_Fat_Acc (Str : Iir) return String_Fat_Acc; - pragma Inline (Get_String_Fat_Acc); - -- Return True iff N is an error node. function Is_Error (N : Iir) return Boolean; pragma Inline (Is_Error); diff --git a/src/vhdl/nodes.ads b/src/vhdl/nodes.ads index 3c72b186a..92a173fdd 100644 --- a/src/vhdl/nodes.ads +++ b/src/vhdl/nodes.ads @@ -318,9 +318,9 @@ private Location: Location_Type := Location_Nil; Field0 : Node_Type := Null_Node; - Field1: Node_Type := Null_Node; - Field2: Node_Type := Null_Node; - Field3: Node_Type := Null_Node; + Field1 : Node_Type := Null_Node; + Field2 : Node_Type := Null_Node; + Field3 : Node_Type := Null_Node; case Format is when Format_Short diff --git a/src/vhdl/nodes_meta.adb b/src/vhdl/nodes_meta.adb index e6c5b7db0..9890310f8 100644 --- a/src/vhdl/nodes_meta.adb +++ b/src/vhdl/nodes_meta.adb @@ -49,8 +49,6 @@ package body Nodes_Meta is Field_Fp_Value => Type_Iir_Fp64, Field_Simple_Aggregate_List => Type_Iir_List, Field_Bit_String_Base => Type_Base_Type, - Field_Bit_String_0 => Type_Iir, - Field_Bit_String_1 => Type_Iir, Field_Literal_Origin => Type_Iir, Field_Range_Origin => Type_Iir, Field_Literal_Subtype => Type_Iir, @@ -285,7 +283,7 @@ package body Nodes_Meta is Field_Protected_Type_Body => Type_Iir, Field_Protected_Type_Declaration => Type_Iir, Field_End_Location => Type_Location_Type, - Field_String_Id => Type_String_Id, + Field_String8_Id => Type_String8_Id, Field_String_Length => Type_Int32, Field_Use_Flag => Type_Boolean, Field_End_Has_Reserved_Id => Type_Boolean, @@ -375,10 +373,6 @@ package body Nodes_Meta is return "simple_aggregate_list"; when Field_Bit_String_Base => return "bit_string_base"; - when Field_Bit_String_0 => - return "bit_string_0"; - when Field_Bit_String_1 => - return "bit_string_1"; when Field_Literal_Origin => return "literal_origin"; when Field_Range_Origin => @@ -847,8 +841,8 @@ package body Nodes_Meta is return "protected_type_declaration"; when Field_End_Location => return "end_location"; - when Field_String_Id => - return "string_id"; + when Field_String8_Id => + return "string8_id"; when Field_String_Length => return "string_length"; when Field_Use_Flag => @@ -911,14 +905,12 @@ package body Nodes_Meta is return "floating_point_literal"; when Iir_Kind_Null_Literal => return "null_literal"; - when Iir_Kind_String_Literal => - return "string_literal"; + when Iir_Kind_String_Literal8 => + return "string_literal8"; when Iir_Kind_Physical_Int_Literal => return "physical_int_literal"; when Iir_Kind_Physical_Fp_Literal => return "physical_fp_literal"; - when Iir_Kind_Bit_String_Literal => - return "bit_string_literal"; when Iir_Kind_Simple_Aggregate => return "simple_aggregate"; when Iir_Kind_Overflow_Literal => @@ -1435,10 +1427,6 @@ package body Nodes_Meta is return Attr_None; when Field_Bit_String_Base => return Attr_None; - when Field_Bit_String_0 => - return Attr_None; - when Field_Bit_String_1 => - return Attr_None; when Field_Literal_Origin => return Attr_None; when Field_Range_Origin => @@ -1907,7 +1895,7 @@ package body Nodes_Meta is return Attr_None; when Field_End_Location => return Attr_None; - when Field_String_Id => + when Field_String8_Id => return Attr_None; when Field_String_Length => return Attr_None; @@ -2013,10 +2001,11 @@ package body Nodes_Meta is -- Iir_Kind_Null_Literal Field_Expr_Staticness, Field_Type, - -- Iir_Kind_String_Literal - Field_String_Id, + -- Iir_Kind_String_Literal8 Field_String_Length, + Field_String8_Id, Field_Expr_Staticness, + Field_Bit_String_Base, Field_Literal_Origin, Field_Literal_Subtype, Field_Type, @@ -2032,21 +2021,11 @@ package body Nodes_Meta is Field_Literal_Origin, Field_Unit_Name, Field_Type, - -- Iir_Kind_Bit_String_Literal - Field_String_Id, - Field_String_Length, - Field_Bit_String_Base, - Field_Expr_Staticness, - Field_Literal_Origin, - Field_Literal_Subtype, - Field_Bit_String_0, - Field_Bit_String_1, - Field_Type, -- Iir_Kind_Simple_Aggregate Field_Expr_Staticness, Field_Literal_Origin, - Field_Simple_Aggregate_List, Field_Literal_Subtype, + Field_Simple_Aggregate_List, Field_Type, -- Iir_Kind_Overflow_Literal Field_Expr_Staticness, @@ -3172,8 +3151,8 @@ package body Nodes_Meta is Field_Expr_Staticness, Field_Value_Staticness, Field_Aggregate_Info, - Field_Association_Choices_Chain, Field_Literal_Subtype, + Field_Association_Choices_Chain, Field_Type, -- Iir_Kind_Parenthesis_Expression Field_Expr_Staticness, @@ -3810,235 +3789,234 @@ package body Nodes_Meta is Iir_Kind_Integer_Literal => 45, Iir_Kind_Floating_Point_Literal => 49, Iir_Kind_Null_Literal => 51, - Iir_Kind_String_Literal => 57, - Iir_Kind_Physical_Int_Literal => 62, - Iir_Kind_Physical_Fp_Literal => 67, - Iir_Kind_Bit_String_Literal => 76, - Iir_Kind_Simple_Aggregate => 81, - Iir_Kind_Overflow_Literal => 84, - Iir_Kind_Waveform_Element => 87, - Iir_Kind_Conditional_Waveform => 90, - Iir_Kind_Association_Element_By_Expression => 97, - Iir_Kind_Association_Element_By_Individual => 103, - Iir_Kind_Association_Element_Open => 108, - Iir_Kind_Association_Element_Package => 114, - Iir_Kind_Choice_By_Others => 119, - Iir_Kind_Choice_By_Expression => 126, - Iir_Kind_Choice_By_Range => 133, - Iir_Kind_Choice_By_None => 138, - Iir_Kind_Choice_By_Name => 144, - Iir_Kind_Entity_Aspect_Entity => 146, - Iir_Kind_Entity_Aspect_Configuration => 147, - Iir_Kind_Entity_Aspect_Open => 147, - Iir_Kind_Block_Configuration => 153, - Iir_Kind_Block_Header => 157, - Iir_Kind_Component_Configuration => 163, - Iir_Kind_Binding_Indication => 169, - Iir_Kind_Entity_Class => 171, - Iir_Kind_Attribute_Value => 179, - Iir_Kind_Signature => 182, - Iir_Kind_Aggregate_Info => 189, - Iir_Kind_Procedure_Call => 193, - Iir_Kind_Record_Element_Constraint => 199, - Iir_Kind_Array_Element_Resolution => 200, - Iir_Kind_Record_Resolution => 201, - Iir_Kind_Record_Element_Resolution => 204, - Iir_Kind_Attribute_Specification => 212, - Iir_Kind_Disconnection_Specification => 217, - Iir_Kind_Configuration_Specification => 222, - Iir_Kind_Access_Type_Definition => 229, - Iir_Kind_Incomplete_Type_Definition => 236, - Iir_Kind_File_Type_Definition => 243, - Iir_Kind_Protected_Type_Declaration => 252, - Iir_Kind_Record_Type_Definition => 262, - Iir_Kind_Array_Type_Definition => 274, - Iir_Kind_Array_Subtype_Definition => 289, - Iir_Kind_Record_Subtype_Definition => 300, - Iir_Kind_Access_Subtype_Definition => 308, - Iir_Kind_Physical_Subtype_Definition => 317, - Iir_Kind_Floating_Subtype_Definition => 327, - Iir_Kind_Integer_Subtype_Definition => 336, - Iir_Kind_Enumeration_Subtype_Definition => 345, - Iir_Kind_Enumeration_Type_Definition => 354, - Iir_Kind_Integer_Type_Definition => 360, - Iir_Kind_Floating_Type_Definition => 366, - Iir_Kind_Physical_Type_Definition => 375, - Iir_Kind_Range_Expression => 381, - Iir_Kind_Protected_Type_Body => 388, - Iir_Kind_Subtype_Definition => 392, - Iir_Kind_Scalar_Nature_Definition => 396, - Iir_Kind_Overload_List => 397, - Iir_Kind_Type_Declaration => 403, - Iir_Kind_Anonymous_Type_Declaration => 408, - Iir_Kind_Subtype_Declaration => 416, - Iir_Kind_Nature_Declaration => 422, - Iir_Kind_Subnature_Declaration => 428, - Iir_Kind_Package_Declaration => 438, - Iir_Kind_Package_Instantiation_Declaration => 449, - Iir_Kind_Package_Body => 456, - Iir_Kind_Configuration_Declaration => 465, - Iir_Kind_Entity_Declaration => 477, - Iir_Kind_Architecture_Body => 489, - Iir_Kind_Package_Header => 491, - Iir_Kind_Unit_Declaration => 500, - Iir_Kind_Library_Declaration => 507, - Iir_Kind_Component_Declaration => 517, - Iir_Kind_Attribute_Declaration => 524, - Iir_Kind_Group_Template_Declaration => 530, - Iir_Kind_Group_Declaration => 537, - Iir_Kind_Element_Declaration => 544, - Iir_Kind_Non_Object_Alias_Declaration => 552, - Iir_Kind_Psl_Declaration => 560, - Iir_Kind_Terminal_Declaration => 566, - Iir_Kind_Free_Quantity_Declaration => 575, - Iir_Kind_Across_Quantity_Declaration => 587, - Iir_Kind_Through_Quantity_Declaration => 599, - Iir_Kind_Enumeration_Literal => 610, - Iir_Kind_Function_Declaration => 634, - Iir_Kind_Procedure_Declaration => 656, - Iir_Kind_Function_Body => 666, - Iir_Kind_Procedure_Body => 676, - Iir_Kind_Object_Alias_Declaration => 688, - Iir_Kind_File_Declaration => 703, - Iir_Kind_Guard_Signal_Declaration => 716, - Iir_Kind_Signal_Declaration => 733, - Iir_Kind_Variable_Declaration => 746, - Iir_Kind_Constant_Declaration => 760, - Iir_Kind_Iterator_Declaration => 772, - Iir_Kind_Interface_Constant_Declaration => 788, - Iir_Kind_Interface_Variable_Declaration => 804, - Iir_Kind_Interface_Signal_Declaration => 825, - Iir_Kind_Interface_File_Declaration => 841, - Iir_Kind_Interface_Package_Declaration => 850, - Iir_Kind_Identity_Operator => 854, - Iir_Kind_Negation_Operator => 858, - Iir_Kind_Absolute_Operator => 862, - Iir_Kind_Not_Operator => 866, - Iir_Kind_Condition_Operator => 870, - Iir_Kind_Reduction_And_Operator => 874, - Iir_Kind_Reduction_Or_Operator => 878, - Iir_Kind_Reduction_Nand_Operator => 882, - Iir_Kind_Reduction_Nor_Operator => 886, - Iir_Kind_Reduction_Xor_Operator => 890, - Iir_Kind_Reduction_Xnor_Operator => 894, - Iir_Kind_And_Operator => 899, - Iir_Kind_Or_Operator => 904, - Iir_Kind_Nand_Operator => 909, - Iir_Kind_Nor_Operator => 914, - Iir_Kind_Xor_Operator => 919, - Iir_Kind_Xnor_Operator => 924, - Iir_Kind_Equality_Operator => 929, - Iir_Kind_Inequality_Operator => 934, - Iir_Kind_Less_Than_Operator => 939, - Iir_Kind_Less_Than_Or_Equal_Operator => 944, - Iir_Kind_Greater_Than_Operator => 949, - Iir_Kind_Greater_Than_Or_Equal_Operator => 954, - Iir_Kind_Match_Equality_Operator => 959, - Iir_Kind_Match_Inequality_Operator => 964, - Iir_Kind_Match_Less_Than_Operator => 969, - Iir_Kind_Match_Less_Than_Or_Equal_Operator => 974, - Iir_Kind_Match_Greater_Than_Operator => 979, - Iir_Kind_Match_Greater_Than_Or_Equal_Operator => 984, - Iir_Kind_Sll_Operator => 989, - Iir_Kind_Sla_Operator => 994, - Iir_Kind_Srl_Operator => 999, - Iir_Kind_Sra_Operator => 1004, - Iir_Kind_Rol_Operator => 1009, - Iir_Kind_Ror_Operator => 1014, - Iir_Kind_Addition_Operator => 1019, - Iir_Kind_Substraction_Operator => 1024, - Iir_Kind_Concatenation_Operator => 1029, - Iir_Kind_Multiplication_Operator => 1034, - Iir_Kind_Division_Operator => 1039, - Iir_Kind_Modulus_Operator => 1044, - Iir_Kind_Remainder_Operator => 1049, - Iir_Kind_Exponentiation_Operator => 1054, - Iir_Kind_Function_Call => 1062, - Iir_Kind_Aggregate => 1068, - Iir_Kind_Parenthesis_Expression => 1071, - Iir_Kind_Qualified_Expression => 1075, - Iir_Kind_Type_Conversion => 1080, - Iir_Kind_Allocator_By_Expression => 1084, - Iir_Kind_Allocator_By_Subtype => 1088, - Iir_Kind_Selected_Element => 1094, - Iir_Kind_Dereference => 1099, - Iir_Kind_Implicit_Dereference => 1104, - Iir_Kind_Slice_Name => 1111, - Iir_Kind_Indexed_Name => 1117, - Iir_Kind_Psl_Expression => 1119, - Iir_Kind_Sensitized_Process_Statement => 1138, - Iir_Kind_Process_Statement => 1156, - Iir_Kind_Concurrent_Conditional_Signal_Assignment => 1167, - Iir_Kind_Concurrent_Selected_Signal_Assignment => 1179, - Iir_Kind_Concurrent_Assertion_Statement => 1187, - Iir_Kind_Psl_Default_Clock => 1191, - Iir_Kind_Psl_Assert_Statement => 1200, - Iir_Kind_Psl_Cover_Statement => 1209, - Iir_Kind_Concurrent_Procedure_Call_Statement => 1215, - Iir_Kind_Block_Statement => 1228, - Iir_Kind_Generate_Statement => 1240, - Iir_Kind_Component_Instantiation_Statement => 1250, - Iir_Kind_Simple_Simultaneous_Statement => 1257, - Iir_Kind_Signal_Assignment_Statement => 1266, - Iir_Kind_Null_Statement => 1270, - Iir_Kind_Assertion_Statement => 1277, - Iir_Kind_Report_Statement => 1283, - Iir_Kind_Wait_Statement => 1290, - Iir_Kind_Variable_Assignment_Statement => 1296, - Iir_Kind_Return_Statement => 1302, - Iir_Kind_For_Loop_Statement => 1310, - Iir_Kind_While_Loop_Statement => 1317, - Iir_Kind_Next_Statement => 1323, - Iir_Kind_Exit_Statement => 1329, - Iir_Kind_Case_Statement => 1336, - Iir_Kind_Procedure_Call_Statement => 1341, - Iir_Kind_If_Statement => 1349, - Iir_Kind_Elsif => 1354, - Iir_Kind_Character_Literal => 1361, - Iir_Kind_Simple_Name => 1368, - Iir_Kind_Selected_Name => 1376, - Iir_Kind_Operator_Symbol => 1381, - Iir_Kind_Selected_By_All_Name => 1386, - Iir_Kind_Parenthesis_Name => 1390, - Iir_Kind_Base_Attribute => 1392, - Iir_Kind_Left_Type_Attribute => 1397, - Iir_Kind_Right_Type_Attribute => 1402, - Iir_Kind_High_Type_Attribute => 1407, - Iir_Kind_Low_Type_Attribute => 1412, - Iir_Kind_Ascending_Type_Attribute => 1417, - Iir_Kind_Image_Attribute => 1423, - Iir_Kind_Value_Attribute => 1429, - Iir_Kind_Pos_Attribute => 1435, - Iir_Kind_Val_Attribute => 1441, - Iir_Kind_Succ_Attribute => 1447, - Iir_Kind_Pred_Attribute => 1453, - Iir_Kind_Leftof_Attribute => 1459, - Iir_Kind_Rightof_Attribute => 1465, - Iir_Kind_Delayed_Attribute => 1473, - Iir_Kind_Stable_Attribute => 1481, - Iir_Kind_Quiet_Attribute => 1489, - Iir_Kind_Transaction_Attribute => 1497, - Iir_Kind_Event_Attribute => 1501, - Iir_Kind_Active_Attribute => 1505, - Iir_Kind_Last_Event_Attribute => 1509, - Iir_Kind_Last_Active_Attribute => 1513, - Iir_Kind_Last_Value_Attribute => 1517, - Iir_Kind_Driving_Attribute => 1521, - Iir_Kind_Driving_Value_Attribute => 1525, - Iir_Kind_Behavior_Attribute => 1525, - Iir_Kind_Structure_Attribute => 1525, - Iir_Kind_Simple_Name_Attribute => 1532, - Iir_Kind_Instance_Name_Attribute => 1537, - Iir_Kind_Path_Name_Attribute => 1542, - Iir_Kind_Left_Array_Attribute => 1549, - Iir_Kind_Right_Array_Attribute => 1556, - Iir_Kind_High_Array_Attribute => 1563, - Iir_Kind_Low_Array_Attribute => 1570, - Iir_Kind_Length_Array_Attribute => 1577, - Iir_Kind_Ascending_Array_Attribute => 1584, - Iir_Kind_Range_Array_Attribute => 1591, - Iir_Kind_Reverse_Range_Array_Attribute => 1598, - Iir_Kind_Attribute_Name => 1606 + Iir_Kind_String_Literal8 => 58, + Iir_Kind_Physical_Int_Literal => 63, + Iir_Kind_Physical_Fp_Literal => 68, + Iir_Kind_Simple_Aggregate => 73, + Iir_Kind_Overflow_Literal => 76, + Iir_Kind_Waveform_Element => 79, + Iir_Kind_Conditional_Waveform => 82, + Iir_Kind_Association_Element_By_Expression => 89, + Iir_Kind_Association_Element_By_Individual => 95, + Iir_Kind_Association_Element_Open => 100, + Iir_Kind_Association_Element_Package => 106, + Iir_Kind_Choice_By_Others => 111, + Iir_Kind_Choice_By_Expression => 118, + Iir_Kind_Choice_By_Range => 125, + Iir_Kind_Choice_By_None => 130, + Iir_Kind_Choice_By_Name => 136, + Iir_Kind_Entity_Aspect_Entity => 138, + Iir_Kind_Entity_Aspect_Configuration => 139, + Iir_Kind_Entity_Aspect_Open => 139, + Iir_Kind_Block_Configuration => 145, + Iir_Kind_Block_Header => 149, + Iir_Kind_Component_Configuration => 155, + Iir_Kind_Binding_Indication => 161, + Iir_Kind_Entity_Class => 163, + Iir_Kind_Attribute_Value => 171, + Iir_Kind_Signature => 174, + Iir_Kind_Aggregate_Info => 181, + Iir_Kind_Procedure_Call => 185, + Iir_Kind_Record_Element_Constraint => 191, + Iir_Kind_Array_Element_Resolution => 192, + Iir_Kind_Record_Resolution => 193, + Iir_Kind_Record_Element_Resolution => 196, + Iir_Kind_Attribute_Specification => 204, + Iir_Kind_Disconnection_Specification => 209, + Iir_Kind_Configuration_Specification => 214, + Iir_Kind_Access_Type_Definition => 221, + Iir_Kind_Incomplete_Type_Definition => 228, + Iir_Kind_File_Type_Definition => 235, + Iir_Kind_Protected_Type_Declaration => 244, + Iir_Kind_Record_Type_Definition => 254, + Iir_Kind_Array_Type_Definition => 266, + Iir_Kind_Array_Subtype_Definition => 281, + Iir_Kind_Record_Subtype_Definition => 292, + Iir_Kind_Access_Subtype_Definition => 300, + Iir_Kind_Physical_Subtype_Definition => 309, + Iir_Kind_Floating_Subtype_Definition => 319, + Iir_Kind_Integer_Subtype_Definition => 328, + Iir_Kind_Enumeration_Subtype_Definition => 337, + Iir_Kind_Enumeration_Type_Definition => 346, + Iir_Kind_Integer_Type_Definition => 352, + Iir_Kind_Floating_Type_Definition => 358, + Iir_Kind_Physical_Type_Definition => 367, + Iir_Kind_Range_Expression => 373, + Iir_Kind_Protected_Type_Body => 380, + Iir_Kind_Subtype_Definition => 384, + Iir_Kind_Scalar_Nature_Definition => 388, + Iir_Kind_Overload_List => 389, + Iir_Kind_Type_Declaration => 395, + Iir_Kind_Anonymous_Type_Declaration => 400, + Iir_Kind_Subtype_Declaration => 408, + Iir_Kind_Nature_Declaration => 414, + Iir_Kind_Subnature_Declaration => 420, + Iir_Kind_Package_Declaration => 430, + Iir_Kind_Package_Instantiation_Declaration => 441, + Iir_Kind_Package_Body => 448, + Iir_Kind_Configuration_Declaration => 457, + Iir_Kind_Entity_Declaration => 469, + Iir_Kind_Architecture_Body => 481, + Iir_Kind_Package_Header => 483, + Iir_Kind_Unit_Declaration => 492, + Iir_Kind_Library_Declaration => 499, + Iir_Kind_Component_Declaration => 509, + Iir_Kind_Attribute_Declaration => 516, + Iir_Kind_Group_Template_Declaration => 522, + Iir_Kind_Group_Declaration => 529, + Iir_Kind_Element_Declaration => 536, + Iir_Kind_Non_Object_Alias_Declaration => 544, + Iir_Kind_Psl_Declaration => 552, + Iir_Kind_Terminal_Declaration => 558, + Iir_Kind_Free_Quantity_Declaration => 567, + Iir_Kind_Across_Quantity_Declaration => 579, + Iir_Kind_Through_Quantity_Declaration => 591, + Iir_Kind_Enumeration_Literal => 602, + Iir_Kind_Function_Declaration => 626, + Iir_Kind_Procedure_Declaration => 648, + Iir_Kind_Function_Body => 658, + Iir_Kind_Procedure_Body => 668, + Iir_Kind_Object_Alias_Declaration => 680, + Iir_Kind_File_Declaration => 695, + Iir_Kind_Guard_Signal_Declaration => 708, + Iir_Kind_Signal_Declaration => 725, + Iir_Kind_Variable_Declaration => 738, + Iir_Kind_Constant_Declaration => 752, + Iir_Kind_Iterator_Declaration => 764, + Iir_Kind_Interface_Constant_Declaration => 780, + Iir_Kind_Interface_Variable_Declaration => 796, + Iir_Kind_Interface_Signal_Declaration => 817, + Iir_Kind_Interface_File_Declaration => 833, + Iir_Kind_Interface_Package_Declaration => 842, + Iir_Kind_Identity_Operator => 846, + Iir_Kind_Negation_Operator => 850, + Iir_Kind_Absolute_Operator => 854, + Iir_Kind_Not_Operator => 858, + Iir_Kind_Condition_Operator => 862, + Iir_Kind_Reduction_And_Operator => 866, + Iir_Kind_Reduction_Or_Operator => 870, + Iir_Kind_Reduction_Nand_Operator => 874, + Iir_Kind_Reduction_Nor_Operator => 878, + Iir_Kind_Reduction_Xor_Operator => 882, + Iir_Kind_Reduction_Xnor_Operator => 886, + Iir_Kind_And_Operator => 891, + Iir_Kind_Or_Operator => 896, + Iir_Kind_Nand_Operator => 901, + Iir_Kind_Nor_Operator => 906, + Iir_Kind_Xor_Operator => 911, + Iir_Kind_Xnor_Operator => 916, + Iir_Kind_Equality_Operator => 921, + Iir_Kind_Inequality_Operator => 926, + Iir_Kind_Less_Than_Operator => 931, + Iir_Kind_Less_Than_Or_Equal_Operator => 936, + Iir_Kind_Greater_Than_Operator => 941, + Iir_Kind_Greater_Than_Or_Equal_Operator => 946, + Iir_Kind_Match_Equality_Operator => 951, + Iir_Kind_Match_Inequality_Operator => 956, + Iir_Kind_Match_Less_Than_Operator => 961, + Iir_Kind_Match_Less_Than_Or_Equal_Operator => 966, + Iir_Kind_Match_Greater_Than_Operator => 971, + Iir_Kind_Match_Greater_Than_Or_Equal_Operator => 976, + Iir_Kind_Sll_Operator => 981, + Iir_Kind_Sla_Operator => 986, + Iir_Kind_Srl_Operator => 991, + Iir_Kind_Sra_Operator => 996, + Iir_Kind_Rol_Operator => 1001, + Iir_Kind_Ror_Operator => 1006, + Iir_Kind_Addition_Operator => 1011, + Iir_Kind_Substraction_Operator => 1016, + Iir_Kind_Concatenation_Operator => 1021, + Iir_Kind_Multiplication_Operator => 1026, + Iir_Kind_Division_Operator => 1031, + Iir_Kind_Modulus_Operator => 1036, + Iir_Kind_Remainder_Operator => 1041, + Iir_Kind_Exponentiation_Operator => 1046, + Iir_Kind_Function_Call => 1054, + Iir_Kind_Aggregate => 1060, + Iir_Kind_Parenthesis_Expression => 1063, + Iir_Kind_Qualified_Expression => 1067, + Iir_Kind_Type_Conversion => 1072, + Iir_Kind_Allocator_By_Expression => 1076, + Iir_Kind_Allocator_By_Subtype => 1080, + Iir_Kind_Selected_Element => 1086, + Iir_Kind_Dereference => 1091, + Iir_Kind_Implicit_Dereference => 1096, + Iir_Kind_Slice_Name => 1103, + Iir_Kind_Indexed_Name => 1109, + Iir_Kind_Psl_Expression => 1111, + Iir_Kind_Sensitized_Process_Statement => 1130, + Iir_Kind_Process_Statement => 1148, + Iir_Kind_Concurrent_Conditional_Signal_Assignment => 1159, + Iir_Kind_Concurrent_Selected_Signal_Assignment => 1171, + Iir_Kind_Concurrent_Assertion_Statement => 1179, + Iir_Kind_Psl_Default_Clock => 1183, + Iir_Kind_Psl_Assert_Statement => 1192, + Iir_Kind_Psl_Cover_Statement => 1201, + Iir_Kind_Concurrent_Procedure_Call_Statement => 1207, + Iir_Kind_Block_Statement => 1220, + Iir_Kind_Generate_Statement => 1232, + Iir_Kind_Component_Instantiation_Statement => 1242, + Iir_Kind_Simple_Simultaneous_Statement => 1249, + Iir_Kind_Signal_Assignment_Statement => 1258, + Iir_Kind_Null_Statement => 1262, + Iir_Kind_Assertion_Statement => 1269, + Iir_Kind_Report_Statement => 1275, + Iir_Kind_Wait_Statement => 1282, + Iir_Kind_Variable_Assignment_Statement => 1288, + Iir_Kind_Return_Statement => 1294, + Iir_Kind_For_Loop_Statement => 1302, + Iir_Kind_While_Loop_Statement => 1309, + Iir_Kind_Next_Statement => 1315, + Iir_Kind_Exit_Statement => 1321, + Iir_Kind_Case_Statement => 1328, + Iir_Kind_Procedure_Call_Statement => 1333, + Iir_Kind_If_Statement => 1341, + Iir_Kind_Elsif => 1346, + Iir_Kind_Character_Literal => 1353, + Iir_Kind_Simple_Name => 1360, + Iir_Kind_Selected_Name => 1368, + Iir_Kind_Operator_Symbol => 1373, + Iir_Kind_Selected_By_All_Name => 1378, + Iir_Kind_Parenthesis_Name => 1382, + Iir_Kind_Base_Attribute => 1384, + Iir_Kind_Left_Type_Attribute => 1389, + Iir_Kind_Right_Type_Attribute => 1394, + Iir_Kind_High_Type_Attribute => 1399, + Iir_Kind_Low_Type_Attribute => 1404, + Iir_Kind_Ascending_Type_Attribute => 1409, + Iir_Kind_Image_Attribute => 1415, + Iir_Kind_Value_Attribute => 1421, + Iir_Kind_Pos_Attribute => 1427, + Iir_Kind_Val_Attribute => 1433, + Iir_Kind_Succ_Attribute => 1439, + Iir_Kind_Pred_Attribute => 1445, + Iir_Kind_Leftof_Attribute => 1451, + Iir_Kind_Rightof_Attribute => 1457, + Iir_Kind_Delayed_Attribute => 1465, + Iir_Kind_Stable_Attribute => 1473, + Iir_Kind_Quiet_Attribute => 1481, + Iir_Kind_Transaction_Attribute => 1489, + Iir_Kind_Event_Attribute => 1493, + Iir_Kind_Active_Attribute => 1497, + Iir_Kind_Last_Event_Attribute => 1501, + Iir_Kind_Last_Active_Attribute => 1505, + Iir_Kind_Last_Value_Attribute => 1509, + Iir_Kind_Driving_Attribute => 1513, + Iir_Kind_Driving_Value_Attribute => 1517, + Iir_Kind_Behavior_Attribute => 1517, + Iir_Kind_Structure_Attribute => 1517, + Iir_Kind_Simple_Name_Attribute => 1524, + Iir_Kind_Instance_Name_Attribute => 1529, + Iir_Kind_Path_Name_Attribute => 1534, + Iir_Kind_Left_Array_Attribute => 1541, + Iir_Kind_Right_Array_Attribute => 1548, + Iir_Kind_High_Array_Attribute => 1555, + Iir_Kind_Low_Array_Attribute => 1562, + Iir_Kind_Length_Array_Attribute => 1569, + Iir_Kind_Ascending_Array_Attribute => 1576, + Iir_Kind_Range_Array_Attribute => 1583, + Iir_Kind_Reverse_Range_Array_Attribute => 1590, + Iir_Kind_Attribute_Name => 1598 ); function Get_Fields (K : Iir_Kind) return Fields_Array @@ -4346,10 +4324,6 @@ package body Nodes_Meta is return Get_Physical_Literal (N); when Field_Physical_Unit_Value => return Get_Physical_Unit_Value (N); - when Field_Bit_String_0 => - return Get_Bit_String_0 (N); - when Field_Bit_String_1 => - return Get_Bit_String_1 (N); when Field_Literal_Origin => return Get_Literal_Origin (N); when Field_Range_Origin => @@ -4706,10 +4680,6 @@ package body Nodes_Meta is Set_Physical_Literal (N, V); when Field_Physical_Unit_Value => Set_Physical_Unit_Value (N, V); - when Field_Bit_String_0 => - Set_Bit_String_0 (N, V); - when Field_Bit_String_1 => - Set_Bit_String_1 (N, V); when Field_Literal_Origin => Set_Literal_Origin (N, V); when Field_Range_Origin => @@ -5675,29 +5645,29 @@ package body Nodes_Meta is end case; end Set_Source_Ptr; - function Get_String_Id - (N : Iir; F : Fields_Enum) return String_Id is + function Get_String8_Id + (N : Iir; F : Fields_Enum) return String8_Id is begin - pragma Assert (Fields_Type (F) = Type_String_Id); + pragma Assert (Fields_Type (F) = Type_String8_Id); case F is - when Field_String_Id => - return Get_String_Id (N); + when Field_String8_Id => + return Get_String8_Id (N); when others => raise Internal_Error; end case; - end Get_String_Id; + end Get_String8_Id; - procedure Set_String_Id - (N : Iir; F : Fields_Enum; V: String_Id) is + procedure Set_String8_Id + (N : Iir; F : Fields_Enum; V: String8_Id) is begin - pragma Assert (Fields_Type (F) = Type_String_Id); + pragma Assert (Fields_Type (F) = Type_String8_Id); case F is - when Field_String_Id => - Set_String_Id (N, V); + when Field_String8_Id => + Set_String8_Id (N, V); when others => raise Internal_Error; end case; - end Set_String_Id; + end Set_String8_Id; function Get_Time_Stamp_Id (N : Iir; F : Fields_Enum) return Time_Stamp_Id is @@ -5951,28 +5921,17 @@ package body Nodes_Meta is function Has_Bit_String_Base (K : Iir_Kind) return Boolean is begin - return K = Iir_Kind_Bit_String_Literal; + return K = Iir_Kind_String_Literal8; end Has_Bit_String_Base; - function Has_Bit_String_0 (K : Iir_Kind) return Boolean is - begin - return K = Iir_Kind_Bit_String_Literal; - end Has_Bit_String_0; - - function Has_Bit_String_1 (K : Iir_Kind) return Boolean is - begin - return K = Iir_Kind_Bit_String_Literal; - end Has_Bit_String_1; - function Has_Literal_Origin (K : Iir_Kind) return Boolean is begin case K is when Iir_Kind_Integer_Literal | Iir_Kind_Floating_Point_Literal - | Iir_Kind_String_Literal + | Iir_Kind_String_Literal8 | Iir_Kind_Physical_Int_Literal | Iir_Kind_Physical_Fp_Literal - | Iir_Kind_Bit_String_Literal | Iir_Kind_Simple_Aggregate | Iir_Kind_Overflow_Literal | Iir_Kind_Enumeration_Literal => @@ -5990,8 +5949,7 @@ package body Nodes_Meta is function Has_Literal_Subtype (K : Iir_Kind) return Boolean is begin case K is - when Iir_Kind_String_Literal - | Iir_Kind_Bit_String_Literal + when Iir_Kind_String_Literal8 | Iir_Kind_Simple_Aggregate | Iir_Kind_Aggregate => return True; @@ -6435,10 +6393,9 @@ package body Nodes_Meta is | Iir_Kind_Integer_Literal | Iir_Kind_Floating_Point_Literal | Iir_Kind_Null_Literal - | Iir_Kind_String_Literal + | Iir_Kind_String_Literal8 | Iir_Kind_Physical_Int_Literal | Iir_Kind_Physical_Fp_Literal - | Iir_Kind_Bit_String_Literal | Iir_Kind_Simple_Aggregate | Iir_Kind_Overflow_Literal | Iir_Kind_Attribute_Value @@ -8204,10 +8161,9 @@ package body Nodes_Meta is | Iir_Kind_Integer_Literal | Iir_Kind_Floating_Point_Literal | Iir_Kind_Null_Literal - | Iir_Kind_String_Literal + | Iir_Kind_String_Literal8 | Iir_Kind_Physical_Int_Literal | Iir_Kind_Physical_Fp_Literal - | Iir_Kind_Bit_String_Literal | Iir_Kind_Simple_Aggregate | Iir_Kind_Overflow_Literal | Iir_Kind_Attribute_Value @@ -8977,26 +8933,14 @@ package body Nodes_Meta is return K = Iir_Kind_Design_Unit; end Has_End_Location; - function Has_String_Id (K : Iir_Kind) return Boolean is + function Has_String8_Id (K : Iir_Kind) return Boolean is begin - case K is - when Iir_Kind_String_Literal - | Iir_Kind_Bit_String_Literal => - return True; - when others => - return False; - end case; - end Has_String_Id; + return K = Iir_Kind_String_Literal8; + end Has_String8_Id; function Has_String_Length (K : Iir_Kind) return Boolean is begin - case K is - when Iir_Kind_String_Literal - | Iir_Kind_Bit_String_Literal => - return True; - when others => - return False; - end case; + return K = Iir_Kind_String_Literal8; end Has_String_Length; function Has_Use_Flag (K : Iir_Kind) return Boolean is diff --git a/src/vhdl/nodes_meta.ads b/src/vhdl/nodes_meta.ads index 7ce120aaf..a120a769a 100644 --- a/src/vhdl/nodes_meta.ads +++ b/src/vhdl/nodes_meta.ads @@ -49,7 +49,7 @@ package Nodes_Meta is Type_PSL_NFA, Type_PSL_Node, Type_Source_Ptr, - Type_String_Id, + Type_String8_Id, Type_Time_Stamp_Id, Type_Token_Type, Type_Tri_State_Type @@ -88,8 +88,6 @@ package Nodes_Meta is Field_Fp_Value, Field_Simple_Aggregate_List, Field_Bit_String_Base, - Field_Bit_String_0, - Field_Bit_String_1, Field_Literal_Origin, Field_Range_Origin, Field_Literal_Subtype, @@ -324,7 +322,7 @@ package Nodes_Meta is Field_Protected_Type_Body, Field_Protected_Type_Declaration, Field_End_Location, - Field_String_Id, + Field_String8_Id, Field_String_Length, Field_Use_Flag, Field_End_Has_Reserved_Id, @@ -500,10 +498,10 @@ package Nodes_Meta is procedure Set_Source_Ptr (N : Iir; F : Fields_Enum; V: Source_Ptr); - function Get_String_Id - (N : Iir; F : Fields_Enum) return String_Id; - procedure Set_String_Id - (N : Iir; F : Fields_Enum; V: String_Id); + function Get_String8_Id + (N : Iir; F : Fields_Enum) return String8_Id; + procedure Set_String8_Id + (N : Iir; F : Fields_Enum; V: String8_Id); function Get_Time_Stamp_Id (N : Iir; F : Fields_Enum) return Time_Stamp_Id; @@ -550,8 +548,6 @@ package Nodes_Meta is function Has_Fp_Value (K : Iir_Kind) return Boolean; function Has_Simple_Aggregate_List (K : Iir_Kind) return Boolean; function Has_Bit_String_Base (K : Iir_Kind) return Boolean; - function Has_Bit_String_0 (K : Iir_Kind) return Boolean; - function Has_Bit_String_1 (K : Iir_Kind) return Boolean; function Has_Literal_Origin (K : Iir_Kind) return Boolean; function Has_Range_Origin (K : Iir_Kind) return Boolean; function Has_Literal_Subtype (K : Iir_Kind) return Boolean; @@ -794,7 +790,7 @@ package Nodes_Meta is function Has_Protected_Type_Body (K : Iir_Kind) return Boolean; function Has_Protected_Type_Declaration (K : Iir_Kind) return Boolean; function Has_End_Location (K : Iir_Kind) return Boolean; - function Has_String_Id (K : Iir_Kind) return Boolean; + function Has_String8_Id (K : Iir_Kind) return Boolean; function Has_String_Length (K : Iir_Kind) return Boolean; function Has_Use_Flag (K : Iir_Kind) return Boolean; function Has_End_Has_Reserved_Id (K : Iir_Kind) return Boolean; diff --git a/src/vhdl/parse.adb b/src/vhdl/parse.adb index 0611fc548..dedcee1a7 100644 --- a/src/vhdl/parse.adb +++ b/src/vhdl/parse.adb @@ -457,7 +457,7 @@ package body Parse is -- Convert the STR (0 .. LEN - 1) into a operator symbol identifier. -- Emit an error message if the name is not an operator name. - function Str_To_Operator_Name (Str : String_Fat_Acc; + function Str_To_Operator_Name (Str_Id : String8_Id; Len : Nat32; Loc : Location_Type) return Name_Id is @@ -472,14 +472,14 @@ package body Parse is procedure Bad_Operator_Symbol is begin - Error_Msg_Parse ("""" & String (Str (1 .. Len)) + Error_Msg_Parse ("""" & Str_Table.String_String8 (Str_Id, Len) & """ is not an operator symbol", Loc); end Bad_Operator_Symbol; procedure Check_Vhdl93 is begin if Flags.Vhdl_Std = Vhdl_87 then - Error_Msg_Parse ("""" & String (Str (1 .. Len)) + Error_Msg_Parse ("""" & Str_Table.String_String8 (Str_Id, Len) & """ is not a vhdl87 operator symbol", Loc); end if; end Check_Vhdl93; @@ -487,7 +487,7 @@ package body Parse is Id : Name_Id; C1, C2, C3, C4 : Character; begin - C1 := Str (1); + C1 := Str_Table.Char_String8 (Str_Id, 1); case Len is when 1 => -- =, <, >, +, -, *, /, & @@ -514,7 +514,7 @@ package body Parse is end case; when 2 => -- or, /=, <=, >=, ** - C2 := Str (2); + C2 := Str_Table.Char_String8 (Str_Id, 2); case C1 is when 'o' | 'O' => Id := Name_Or; @@ -564,8 +564,8 @@ package body Parse is when 3 => -- mod, rem, and, xor, nor, abs, not, sll, sla, sra, srl, rol -- ror - C2 := Str (2); - C3 := Str (3); + C2 := Str_Table.Char_String8 (Str_Id, 2); + C3 := Str_Table.Char_String8 (Str_Id, 3); case C1 is when 'm' | 'M' => Id := Name_Mod; @@ -674,9 +674,9 @@ package body Parse is end case; when 4 => -- nand, xnor - C2 := Str (2); - C3 := Str (3); - C4 := Str (4); + C2 := Str_Table.Char_String8 (Str_Id, 2); + C3 := Str_Table.Char_String8 (Str_Id, 3); + C4 := Str_Table.Char_String8 (Str_Id, 4); if (C1 = 'n' or C1 = 'N') and (C2 = 'a' or C2 = 'A') and (C3 = 'n' or C3 = 'N') @@ -704,24 +704,19 @@ package body Parse is function Scan_To_Operator_Name (Loc : Location_Type) return Name_Id is begin return Str_To_Operator_Name - (Str_Table.Get_String_Fat_Acc (Current_String_Id), - Current_String_Length, - Loc); + (Current_String_Id, Current_String_Length, Loc); end Scan_To_Operator_Name; pragma Inline (Scan_To_Operator_Name); -- Convert string literal STR to an operator symbol. -- Emit an error message if the string is not an operator name. - function String_To_Operator_Symbol (Str : Iir_String_Literal) - return Iir + function String_To_Operator_Symbol (Str : Iir) return Iir is Id : Name_Id; Res : Iir; begin Id := Str_To_Operator_Name - (Str_Table.Get_String_Fat_Acc (Get_String_Id (Str)), - Get_String_Length (Str), - Get_Location (Str)); + (Get_String8_Id (Str), Get_String_Length (Str), Get_Location (Str)); Res := Create_Iir (Iir_Kind_Operator_Symbol); Location_Copy (Res, Str); Set_Identifier (Res, Id); @@ -794,7 +789,7 @@ package body Parse is case Current_Token is when Tok_Left_Bracket => - if Get_Kind (Prefix) = Iir_Kind_String_Literal then + if Get_Kind (Prefix) = Iir_Kind_String_Literal8 then Prefix := String_To_Operator_Symbol (Prefix); end if; @@ -805,7 +800,7 @@ package body Parse is when Tok_Tick => -- There is an attribute. - if Get_Kind (Prefix) = Iir_Kind_String_Literal then + if Get_Kind (Prefix) = Iir_Kind_String_Literal8 then Prefix := String_To_Operator_Symbol (Prefix); end if; @@ -841,7 +836,7 @@ package body Parse is return Res; end if; - if Get_Kind (Prefix) = Iir_Kind_String_Literal then + if Get_Kind (Prefix) = Iir_Kind_String_Literal8 then Prefix := String_To_Operator_Symbol (Prefix); end if; @@ -852,7 +847,7 @@ package body Parse is (Res, Parse_Association_List_In_Parenthesis); when Tok_Dot => - if Get_Kind (Prefix) = Iir_Kind_String_Literal then + if Get_Kind (Prefix) = Iir_Kind_String_Literal8 then Prefix := String_To_Operator_Symbol (Prefix); end if; @@ -894,8 +889,9 @@ package body Parse is Set_Identifier (Res, Current_Identifier); Set_Location (Res); when Tok_String => - Res := Create_Iir (Iir_Kind_String_Literal); - Set_String_Id (Res, Current_String_Id); + -- For operator symbol, such as: "+" (A, B). + Res := Create_Iir (Iir_Kind_String_Literal8); + Set_String8_Id (Res, Current_String_Id); Set_String_Length (Res, Current_String_Length); Set_Location (Res); when others => @@ -3950,7 +3946,7 @@ package body Parse is -- precond : next token -- postcond: next token -- - -- [ §7.1 ] + -- [ LRM93 7.1 ] -- primary ::= name -- | literal -- | aggregate @@ -3960,21 +3956,21 @@ package body Parse is -- | allocator -- | ( expression ) -- - -- [ §7.3.1 ] + -- [ LRM93 7.3.1 ] -- literal ::= numeric_literal -- | enumeration_literal -- | string_literal -- | bit_string_literal -- | NULL -- - -- [ §7.3.1 ] + -- [ LRM93 7.3.1 ] -- numeric_literal ::= abstract_literal -- | physical_literal -- - -- [ §13.4 ] + -- [ LRM93 13.4 ] -- abstract_literal ::= decimal_literal | based_literal -- - -- [ §3.1.3 ] + -- [ LRM93 3.1.3 ] -- physical_literal ::= [ abstract_literal ] UNIT_name function Parse_Primary return Iir_Expression is @@ -4048,9 +4044,9 @@ package body Parse is when Tok_New => return Parse_Allocator; when Tok_Bit_String => - Res := Create_Iir (Iir_Kind_Bit_String_Literal); + Res := Create_Iir (Iir_Kind_String_Literal8); Set_Location (Res); - Set_String_Id (Res, Current_String_Id); + Set_String8_Id (Res, Current_String_Id); Set_String_Length (Res, Current_String_Length); case Current_Iir_Int64 is when 1 => diff --git a/src/vhdl/scanner.adb b/src/vhdl/scanner.adb index b480533c5..632e24081 100644 --- a/src/vhdl/scanner.adb +++ b/src/vhdl/scanner.adb @@ -144,7 +144,7 @@ package body Scanner is File_Name: Name_Id; Token: Token_Type; Prev_Token: Token_Type; - Str_Id : String_Id; + Str_Id : String8_Id; Str_Len : Nat32; Identifier: Name_Id; Int64: Iir_Int64; @@ -164,7 +164,7 @@ package body Scanner is Token => Tok_Invalid, Prev_Token => Tok_Invalid, Identifier => Null_Identifier, - Str_Id => Null_String, + Str_Id => Null_String8, Str_Len => 0, Int64 => 0, Fp64 => 0.0); @@ -193,7 +193,7 @@ package body Scanner is end if; end Invalidate_Current_Token; - function Current_String_Id return String_Id is + function Current_String_Id return String8_Id is begin return Current_Context.Str_Id; end Current_String_Id; @@ -275,22 +275,21 @@ package body Scanner is raise Internal_Error; end if; N_Source := Get_File_Source (Source_File); - Current_Context := - (Source => N_Source, - Source_File => Source_File, - Line_Number => 1, - Line_Pos => 0, - Pos => N_Source'First, - Token_Pos => 0, -- should be invalid, - File_Len => Get_File_Length (Source_File), - File_Name => Get_File_Name (Source_File), - Token => Tok_Invalid, - Prev_Token => Tok_Invalid, - Identifier => Null_Identifier, - Str_Id => Null_String, - Str_Len => 0, - Int64 => -1, - Fp64 => 0.0); + Current_Context := (Source => N_Source, + Source_File => Source_File, + Line_Number => 1, + Line_Pos => 0, + Pos => N_Source'First, + Token_Pos => 0, -- should be invalid, + File_Len => Get_File_Length (Source_File), + File_Name => Get_File_Name (Source_File), + Token => Tok_Invalid, + Prev_Token => Tok_Invalid, + Identifier => Null_Identifier, + Str_Id => Null_String8, + Str_Len => 0, + Int64 => -1, + Fp64 => 0.0); Current_Token := Tok_Invalid; end Set_File; @@ -341,16 +340,16 @@ package body Scanner is -- BASE ::= INTEGER procedure Scan_Literal is separate; - -- Scan a string literal. + -- Scan a string literal. -- - -- LRM93 13.6 - -- A string literal is formed by a sequence of graphic characters - -- (possibly none) enclosed between two quotation marks used as string - -- brackets. - -- STRING_LITERAL ::= " { GRAPHIC_CHARACTER } " + -- LRM93 13.6 / LRM08 15.7 + -- A string literal is formed by a sequence of graphic characters + -- (possibly none) enclosed between two quotation marks used as string + -- brackets. + -- STRING_LITERAL ::= " { GRAPHIC_CHARACTER } " -- - -- IN: for a string, at the call of this procedure, the current character - -- must be either '"' or '%'. + -- IN: for a string, at the call of this procedure, the current character + -- must be either '"' or '%'. procedure Scan_String is -- The quotation character (can be " or %). @@ -360,27 +359,27 @@ package body Scanner is -- Current length. Length : Nat32; begin + -- String delimiter. Mark := Source (Pos); - if Mark /= Quotation and then Mark /= '%' then - raise Internal_Error; - end if; + pragma Assert (Mark = Quotation or else Mark = '%'); + Pos := Pos + 1; Length := 0; - Current_Context.Str_Id := Str_Table.Start; + Current_Context.Str_Id := Str_Table.Create_String8; loop C := Source (Pos); if C = Mark then - -- LRM93 13.6 - -- If a quotation mark value is to be represented in the sequence - -- of character values, then a pair of adjacent quoatation - -- characters marks must be written at the corresponding place - -- within the string literal. - -- LRM93 13.10 - -- Any pourcent sign within the sequence of characters must then - -- be doubled, and each such doubled percent sign is interpreted - -- as a single percent sign value. - -- The same replacement is allowed for a bit string literal, - -- provieded that both bit string brackets are replaced. + -- LRM93 13.6 + -- If a quotation mark value is to be represented in the sequence + -- of character values, then a pair of adjacent quoatation + -- characters marks must be written at the corresponding place + -- within the string literal. + -- LRM93 13.10 + -- Any pourcent sign within the sequence of characters must then + -- be doubled, and each such doubled percent sign is interpreted + -- as a single percent sign value. + -- The same replacement is allowed for a bit string literal, + -- provieded that both bit string brackets are replaced. Pos := Pos + 1; exit when Source (Pos) /= Mark; end if; @@ -399,41 +398,39 @@ package body Scanner is end case; if C = Quotation and Mark = '%' then - -- LRM93 13.10 - -- The quotation marks (") used as string brackets at both ends of - -- a string literal can be replaced by percent signs (%), provided - -- that the enclosed sequence of characters constains no quotation - -- marks, and provided that both string brackets are replaced. + -- LRM93 13.10 + -- The quotation marks (") used as string brackets at both ends of + -- a string literal can be replaced by percent signs (%), provided + -- that the enclosed sequence of characters constains no quotation + -- marks, and provided that both string brackets are replaced. Error_Msg_Scan ("'""' cannot be used in a string delimited with '%'"); end if; Length := Length + 1; - Str_Table.Append (C); + Str_Table.Append_String8 (Character'Pos (C)); Pos := Pos + 1; end loop; - Str_Table.Finish; - Current_Token := Tok_String; Current_Context.Str_Len := Length; end Scan_String; - -- Scan a bit string literal. + -- Scan a bit string literal. -- - -- LRM93 13.7 - -- A bit string literal is formed by a sequence of extended digits - -- (possibly none) enclosed between two quotations used as bit string - -- brackets, preceded by a base specifier. - -- BIT_STRING_LITERAL ::= BASE_SPECIFIER " [ BIT_VALUE ] " - -- BIT_VALUE ::= EXTENDED_DIGIT { [ UNDERLINE ] EXTENDED_DIGIT } + -- LRM93 13.7 + -- A bit string literal is formed by a sequence of extended digits + -- (possibly none) enclosed between two quotations used as bit string + -- brackets, preceded by a base specifier. + -- BIT_STRING_LITERAL ::= BASE_SPECIFIER " [ BIT_VALUE ] " + -- BIT_VALUE ::= EXTENDED_DIGIT { [ UNDERLINE ] EXTENDED_DIGIT } -- - -- The current character must be a base specifier, followed by '"' or '%'. - -- The base must be valid. + -- The current character must be a base specifier, followed by '"' or '%'. + -- The base must be valid. procedure Scan_Bit_String is -- The base specifier. - Base_Len : Nat32 range 1 .. 4; + Base_Log : Nat32 range 1 .. 4; -- The quotation character (can be " or %). Mark: Character; -- Current character. @@ -441,26 +438,32 @@ package body Scanner is -- Current length. Length : Nat32; -- Digit value. - V : Natural; + V, D : Nat8; + -- Position of character '0'. + Pos_0 : constant Nat8 := Character'Pos ('0'); begin + -- LRM93 13.7 + -- A letter in a bit string literal (... or the base specificer) can be + -- written either in lowercase or in upper case, with the same meaning. + -- + -- LRM08 15.8 Bit string literals + -- Not present! case Source (Pos) is when 'x' | 'X' => - Base_Len := 4; + Base_Log := 4; when 'o' | 'O' => - Base_Len := 3; + Base_Log := 3; when 'b' | 'B' => - Base_Len := 1; + Base_Log := 1; when others => raise Internal_Error; end case; Pos := Pos + 1; Mark := Source (Pos); - if Mark /= Quotation and then Mark /= '%' then - raise Internal_Error; - end if; + pragma Assert (Mark = Quotation or else Mark = '%'); Pos := Pos + 1; Length := 0; - Current_Context.Str_Id := Str_Table.Start; + Current_Context.Str_Id := Str_Table.Create_String8; loop << Again >> null; C := Source (Pos); @@ -481,6 +484,9 @@ package body Scanner is when 'A' .. 'F' => V := Character'Pos (C) - Character'Pos ('A') + 10; when 'a' .. 'f' => + -- LRM93 13.7 + -- A letter in a bit string literal (...) can be written either + -- in lowercase or in upper case, with the same meaning. V := Character'Pos (C) - Character'Pos ('a') + 10; when '_' => if Source (Pos) = '_' then @@ -511,46 +517,40 @@ package body Scanner is exit; end case; - case Base_Len is + case Base_Log is when 1 => if V > 1 then Error_Msg_Scan ("invalid character in a binary bit string"); + V := 1; end if; - Str_Table.Append (C); + Str_Table.Append_String8 (Pos_0 + V); when 2 => raise Internal_Error; when 3 => if V > 7 then Error_Msg_Scan ("invalid character in a octal bit string"); + V := 7; end if; for I in 1 .. 3 loop - if (V / 4) = 1 then - Str_Table.Append ('1'); - else - Str_Table.Append ('0'); - end if; - V := (V mod 4) * 2; + D := V / 4; + Str_Table.Append_String8 (Pos_0 + D); + V := (V - 4 * D) * 2; end loop; when 4 => for I in 1 .. 4 loop - if (V / 8) = 1 then - Str_Table.Append ('1'); - else - Str_Table.Append ('0'); - end if; - V := (V mod 8) * 2; + D := V / 8; + Str_Table.Append_String8 (Pos_0 + D); + V := (V - 8 * D) * 2; end loop; end case; - Length := Length + Base_Len; + Length := Length + Base_Log; end loop; - Str_Table.Finish; - if Length = 0 then Error_Msg_Scan ("empty bit string is not allowed"); end if; Current_Token := Tok_Bit_String; - Current_Context.Int64 := Iir_Int64 (Base_Len); + Current_Context.Int64 := Iir_Int64 (Base_Log); Current_Context.Str_Len := Length; end Scan_Bit_String; diff --git a/src/vhdl/scanner.ads b/src/vhdl/scanner.ads index ddc0d1819..3edc9c0ba 100644 --- a/src/vhdl/scanner.ads +++ b/src/vhdl/scanner.ads @@ -37,7 +37,7 @@ package Scanner is pragma Inline (Current_Identifier); -- Get current string identifier and length. - function Current_String_Id return String_Id; + function Current_String_Id return String8_Id; function Current_String_Length return Nat32; pragma Inline (Current_String_Id); pragma Inline (Current_String_Length); @@ -48,7 +48,7 @@ package Scanner is pragma Inline (Invalidate_Current_Identifier); -- When CURRENT_TOKEN is tok_integer, returns the value. - -- When CURRENT_TOKEN is tok_bit_string, returns the base. + -- When CURRENT_TOKEN is tok_bit_string, returns the log of the base. function Current_Iir_Int64 return Iir_Int64; pragma Inline (Current_Iir_Int64); diff --git a/src/vhdl/sem.adb b/src/vhdl/sem.adb index 8a0c0338b..a8cbbd4f3 100644 --- a/src/vhdl/sem.adb +++ b/src/vhdl/sem.adb @@ -1351,28 +1351,22 @@ package body Sem is | Iir_Kind_Ascending_Type_Attribute => return Are_Trees_Equal (Get_Prefix (Left), Get_Prefix (Right)); - when Iir_Kind_String_Literal - | Iir_Kind_Bit_String_Literal => - if Get_Kind (Left) = Iir_Kind_Bit_String_Literal - and then Get_Bit_String_Base (Left) - /= Get_Bit_String_Base (Right) - then + when Iir_Kind_String_Literal8 => + if Get_Bit_String_Base (Left) /= Get_Bit_String_Base (Right) then return False; end if; declare use Str_Table; - Len : Nat32; - L_Ptr : String_Fat_Acc; - R_Ptr : String_Fat_Acc; + Len : constant Nat32 := Get_String_Length (Left); + L_Id : constant String8_Id := Get_String8_Id (Left); + R_Id : constant String8_Id := Get_String8_Id (Right); begin - Len := Get_String_Length (Left); if Get_String_Length (Right) /= Len then return False; end if; - L_Ptr := Get_String_Fat_Acc (Get_String_Id (Left)); - R_Ptr := Get_String_Fat_Acc (Get_String_Id (Right)); for I in 1 .. Len loop - if L_Ptr (I) /= R_Ptr (I) then + if Element_String8 (L_Id, I) /= Element_String8 (R_Id, I) + then return False; end if; end loop; diff --git a/src/vhdl/sem_expr.adb b/src/vhdl/sem_expr.adb index 9a3145203..16add4fdc 100644 --- a/src/vhdl/sem_expr.adb +++ b/src/vhdl/sem_expr.adb @@ -22,6 +22,7 @@ with Sem_Scopes; use Sem_Scopes; with Sem_Names; use Sem_Names; with Sem; with Name_Table; +with Str_Table; with Iirs_Utils; use Iirs_Utils; with Evaluation; use Evaluation; with Iir_Chains; use Iir_Chains; @@ -221,7 +222,7 @@ package body Sem_Expr is -- LRM87 7.3.1 -- ... (for string literals) or of type BIT (for bit string literals). if Flags.Vhdl_Std = Vhdl_87 - and then Get_Kind (Expr) = Iir_Kind_Bit_String_Literal + and then Get_Bit_String_Base (Expr) /= Base_None and then El_Bt /= Bit_Type_Definition then return False; @@ -286,8 +287,7 @@ package body Sem_Expr is case Get_Kind (Expr) is when Iir_Kind_Aggregate => return Is_Aggregate_Type (A_Type); - when Iir_Kind_String_Literal - | Iir_Kind_Bit_String_Literal => + when Iir_Kind_String_Literal8 => return Is_String_Literal_Type (A_Type, Expr); when Iir_Kind_Null_Literal => return Is_Null_Literal_Type (A_Type); @@ -1877,17 +1877,16 @@ package body Sem_Expr is -- Semantize LIT whose elements must be of type EL_TYPE, and return -- the length. -- FIXME: the errors are reported, but there is no mark of that. - function Sem_String_Literal (Lit: Iir; El_Type : Iir) return Natural + function Sem_String_Literal (Str : Iir; El_Type : Iir) return Natural is function Find_Literal (Etype : Iir_Enumeration_Type_Definition; C : Character) - return Iir_Enumeration_Literal + return Iir_Enumeration_Literal is + Id : constant Name_Id := Name_Table.Get_Identifier (C); Inter : Name_Interpretation_Type; - Id : Name_Id; Decl : Iir; begin - Id := Name_Table.Get_Identifier (C); Inter := Get_Interpretation (Id); while Valid_Interpretation (Inter) loop Decl := Get_Declaration (Inter); @@ -1905,37 +1904,71 @@ package body Sem_Expr is -- ... because it is not defined. Error_Msg_Sem ("type " & Disp_Node (Etype) & " does not define character '" - & C & "'", Lit); + & C & "'", Str); else -- ... because it is not visible. Error_Msg_Sem ("character '" & C & "' of type " - & Disp_Node (Etype) & " is not visible", Lit); + & Disp_Node (Etype) & " is not visible", Str); end if; return Null_Iir; end Find_Literal; - Ptr : String_Fat_Acc; + type Characters_Pos is array (Character range <>) of Nat8; + Len : constant Nat32 := Get_String_Length (Str); + Id : constant String8_Id := Get_String8_Id (Str); El : Iir; - pragma Unreferenced (El); - Len : Nat32; + Enum_Pos : Iir_Int32; + Ch : Character; begin - Len := Get_String_Length (Lit); + if Get_Bit_String_Base (Str) /= Base_None then + -- A bit string. + declare + Map : Characters_Pos ('0' .. '1'); + begin + for C in Character range '0' .. '1' loop + El := Find_Literal (El_Type, C); + if El = Null_Iir then + Enum_Pos := 0; + else + Enum_Pos := Get_Enum_Pos (El); + end if; + Map (C) := Nat8 (Enum_Pos); + end loop; - if Get_Kind (Lit) = Iir_Kind_Bit_String_Literal then - Set_Bit_String_0 (Lit, Find_Literal (El_Type, '0')); - Set_Bit_String_1 (Lit, Find_Literal (El_Type, '1')); + for I in 1 .. Len loop + Ch := Str_Table.Char_String8 (Id, I); + pragma Assert (Ch in Map'Range); + Str_Table.Set_Element_String8 (Id, I, Map (Ch)); + end loop; + end; else - Ptr := Get_String_Fat_Acc (Lit); - - -- For a string_literal, check all characters of the string is a - -- literal of the type. - -- Always check, for visibility. - for I in 1 .. Len loop - El := Find_Literal (El_Type, Ptr (I)); - end loop; + -- A string. + declare + -- Create a cache of literals, to speed-up a little bit the + -- search. + No_Pos : constant Nat8 := Nat8'Last; + Map : Characters_Pos (' ' .. Character'Last) := (others => No_Pos); + Res : Nat8; + begin + for I in 1 .. Len loop + Ch := Str_Table.Char_String8 (Id, I); + Res := Map (Ch); + if Res = No_Pos then + El := Find_Literal (El_Type, Ch); + if El = Null_Iir then + Res := 0; + else + Enum_Pos := Get_Enum_Pos (El); + Res := Nat8 (Enum_Pos); + Map (Ch) := Res; + end if; + end if; + Str_Table.Set_Element_String8 (Id, I, Res); + end loop; + end; end if; - Set_Expr_Staticness (Lit, Locally); + Set_Expr_Staticness (Str, Locally); return Natural (Len); end Sem_String_Literal; @@ -3103,8 +3136,7 @@ package body Sem_Expr is return; end if; - when Iir_Kind_String_Literal - | Iir_Kind_Bit_String_Literal => + when Iir_Kind_String_Literal8 => Len := Sem_String_Literal (Aggr, Get_Base_Type (Get_Element_Subtype (A_Type))); Assoc_Chain := Null_Iir; @@ -3335,8 +3367,7 @@ package body Sem_Expr is (Assoc, A_Type, Infos, Constrained, Dim + 1); Value_Staticness := Min (Value_Staticness, Get_Value_Staticness (Assoc)); - when Iir_Kind_String_Literal - | Iir_Kind_Bit_String_Literal => + when Iir_Kind_String_Literal8 => if Dim + 1 = Get_Nbr_Elements (Index_List) then Sem_Array_Aggregate_Type_1 (Assoc, A_Type, Infos, Constrained, Dim + 1); @@ -3655,8 +3686,7 @@ package body Sem_Expr is when Iir_Kind_Enumeration_Literal | Iir_Kind_Physical_Int_Literal | Iir_Kind_Physical_Fp_Literal - | Iir_Kind_String_Literal - | Iir_Kind_Bit_String_Literal + | Iir_Kind_String_Literal8 | Iir_Kind_Character_Literal | Iir_Kind_Integer_Literal | Iir_Kind_Floating_Point_Literal @@ -3880,8 +3910,7 @@ package body Sem_Expr is return Res; end; - when Iir_Kind_String_Literal - | Iir_Kind_Bit_String_Literal => + when Iir_Kind_String_Literal8 => -- LRM93 7.3.1 Literals -- The type of a string or bit string literal must be -- determinable solely from the context in whcih the literal @@ -4019,8 +4048,7 @@ package body Sem_Expr is case Get_Kind (Expr) is when Iir_Kind_Aggregate => Res := Sem_Aggregate (Expr, A_Type); - when Iir_Kind_String_Literal - | Iir_Kind_Bit_String_Literal => + when Iir_Kind_String_Literal8 => if A_Type = Null_Iir then Res := Sem_Expression_Ov (Expr, Null_Iir); else diff --git a/src/vhdl/sem_inst.adb b/src/vhdl/sem_inst.adb index 3f5891e57..4993c8347 100644 --- a/src/vhdl/sem_inst.adb +++ b/src/vhdl/sem_inst.adb @@ -246,8 +246,8 @@ package body Sem_Inst is | Type_PSL_Node => -- TODO raise Internal_Error; - when Type_String_Id => - Set_String_Id (Res, F, Get_String_Id (N, F)); + when Type_String8_Id => + Set_String8_Id (Res, F, Get_String8_Id (N, F)); when Type_Source_Ptr => Set_Source_Ptr (Res, F, Get_Source_Ptr (N, F)); when Type_Date_Type diff --git a/src/vhdl/sem_names.adb b/src/vhdl/sem_names.adb index 5a1c123a8..47b9aa29d 100644 --- a/src/vhdl/sem_names.adb +++ b/src/vhdl/sem_names.adb @@ -1124,8 +1124,7 @@ package body Sem_Names is case Get_Kind (Actual) is when Iir_Kind_Null_Literal | Iir_Kind_Aggregate - | Iir_Kind_String_Literal - | Iir_Kind_Bit_String_Literal => + | Iir_Kind_String_Literal8 => Error_Msg_Sem (Disp_Node (Actual) & " cannot be a type conversion operand", Actual); diff --git a/src/vhdl/std_package.adb b/src/vhdl/std_package.adb index 5f65aa249..54ec4e06e 100644 --- a/src/vhdl/std_package.adb +++ b/src/vhdl/std_package.adb @@ -354,11 +354,10 @@ package body Std_Package is "20020601000000.000"; Id : Time_Stamp_Id; begin - Id := Time_Stamp_Id (Str_Table.Start); + Id := Time_Stamp_Id (Str_Table.Create_String8); for I in Time_Stamp_String'Range loop - Str_Table.Append (Std_Time_Stamp (I)); + Str_Table.Append_String8_Char (Std_Time_Stamp (I)); end loop; - Str_Table.Finish; Set_Analysis_Time_Stamp (Std_Standard_File, Id); end; diff --git a/src/vhdl/translate/trans-chap2.adb b/src/vhdl/translate/trans-chap2.adb index dc7807f50..eee425476 100644 --- a/src/vhdl/translate/trans-chap2.adb +++ b/src/vhdl/translate/trans-chap2.adb @@ -1018,7 +1018,7 @@ package body Trans.Chap2 is | Type_Time_Stamp_Id => -- Can this happen ? raise Internal_Error; - when Type_String_Id + when Type_String8_Id | Type_Source_Ptr | Type_Base_Type | Type_Iir_Constraint diff --git a/src/vhdl/translate/trans-chap4.adb b/src/vhdl/translate/trans-chap4.adb index b6f1c66b2..7c71cc7e0 100644 --- a/src/vhdl/translate/trans-chap4.adb +++ b/src/vhdl/translate/trans-chap4.adb @@ -509,7 +509,7 @@ package body Trans.Chap4 is Name_Node := Stabilize (Name); S := Stabilize (E2M (Value_Node, Type_Info, Mode_Value)); - if Get_Kind (Value) = Iir_Kind_String_Literal + if Get_Kind (Value) = Iir_Kind_String_Literal8 and then Get_Kind (Obj) = Iir_Kind_Constant_Declaration then -- No need to allocate space for the object. diff --git a/src/vhdl/translate/trans-chap7.adb b/src/vhdl/translate/trans-chap7.adb index ef0e53a93..96608808e 100644 --- a/src/vhdl/translate/trans-chap7.adb +++ b/src/vhdl/translate/trans-chap7.adb @@ -18,6 +18,7 @@ with Ada.Text_IO; with Name_Table; +with Str_Table; with Iirs_Utils; use Iirs_Utils; with Iir_Chains; use Iir_Chains; with Std_Package; use Std_Package; @@ -98,7 +99,7 @@ package body Trans.Chap7 is return True; end Is_Static_Constant; - procedure Translate_Static_String_Literal_Inner + procedure Translate_Static_String_Literal8_Inner (List : in out O_Array_Aggr_List; Str : Iir; El_Type : Iir) @@ -108,39 +109,15 @@ package body Trans.Chap7 is Literal_List : constant Iir_List := Get_Enumeration_Literal_List (Get_Base_Type (El_Type)); Len : constant Nat32 := Get_String_Length (Str); - Ptr : constant String_Fat_Acc := Get_String_Fat_Acc (Str); + Id : constant String8_Id := Get_String8_Id (Str); Lit : Iir; begin for I in 1 .. Len loop - Lit := Find_Name_In_List (Literal_List, Get_Identifier (Ptr (I))); + Lit := Get_Nth_Element + (Literal_List, Natural (Str_Table.Element_String8 (Id, Pos32 (I)))); New_Array_Aggr_El (List, Get_Ortho_Expr (Lit)); end loop; - end Translate_Static_String_Literal_Inner; - - procedure Translate_Static_Bit_String_Literal_Inner - (List : in out O_Array_Aggr_List; - Lit : Iir_Bit_String_Literal; - El_Type : Iir) - is - pragma Unreferenced (El_Type); - L_0 : constant O_Cnode := Get_Ortho_Expr (Get_Bit_String_0 (Lit)); - L_1 : constant O_Cnode := Get_Ortho_Expr (Get_Bit_String_1 (Lit)); - Ptr : constant String_Fat_Acc := Get_String_Fat_Acc (Lit); - Len : constant Nat32 := Get_String_Length (Lit); - V : O_Cnode; - begin - for I in 1 .. Len loop - case Ptr (I) is - when '0' => - V := L_0; - when '1' => - V := L_1; - when others => - raise Internal_Error; - end case; - New_Array_Aggr_El (List, V); - end loop; - end Translate_Static_Bit_String_Literal_Inner; + end Translate_Static_String_Literal8_Inner; procedure Translate_Static_Aggregate_1 (List : in out O_Array_Aggr_List; Aggr : Iir; @@ -170,16 +147,11 @@ package body Trans.Chap7 is end case; Assoc := Get_Chain (Assoc); end loop; - when Iir_Kind_String_Literal => - if N_Info /= Null_Iir then - raise Internal_Error; - end if; - Translate_Static_String_Literal_Inner (List, Aggr, El_Type); - when Iir_Kind_Bit_String_Literal => + when Iir_Kind_String_Literal8 => if N_Info /= Null_Iir then raise Internal_Error; end if; - Translate_Static_Bit_String_Literal_Inner (List, Aggr, El_Type); + Translate_Static_String_Literal8_Inner (List, Aggr, El_Type); when others => Error_Kind ("translate_static_aggregate_1", Aggr); end case; @@ -224,7 +196,7 @@ package body Trans.Chap7 is return Res; end Translate_Static_Simple_Aggregate; - function Translate_Static_String_Literal (Str : Iir) return O_Cnode + function Translate_Static_String_Literal8 (Str : Iir) return O_Cnode is use Name_Table; @@ -239,11 +211,11 @@ package body Trans.Chap7 is Start_Array_Aggr (List, Arr_Type); - Translate_Static_String_Literal_Inner (List, Str, Element_Type); + Translate_Static_String_Literal8_Inner (List, Str, Element_Type); Finish_Array_Aggr (List, Res); return Res; - end Translate_Static_String_Literal; + end Translate_Static_String_Literal8; -- Create a variable (constant) for string or bit string literal STR. -- The type of the literal element is ELEMENT_TYPE, and the ortho type @@ -258,11 +230,8 @@ package body Trans.Chap7 is begin Start_Array_Aggr (Val_Aggr, Str_Type); case Get_Kind (Str) is - when Iir_Kind_String_Literal => - Translate_Static_String_Literal_Inner - (Val_Aggr, Str, Element_Type); - when Iir_Kind_Bit_String_Literal => - Translate_Static_Bit_String_Literal_Inner + when Iir_Kind_String_Literal8 => + Translate_Static_String_Literal8_Inner (Val_Aggr, Str, Element_Type); when others => raise Internal_Error; @@ -298,6 +267,7 @@ package body Trans.Chap7 is is use Name_Table; + Len : constant Nat32 := Get_String_Length (Str); Lit_Type : constant Iir := Get_Type (Str); Type_Info : constant Type_Info_Acc := Get_Info (Lit_Type); Index_Type : constant Iir := Get_Index_Type (Lit_Type, 0); @@ -306,13 +276,11 @@ package body Trans.Chap7 is Index_Aggr : O_Record_Aggr_List; Res_Aggr : O_Record_Aggr_List; Res : O_Cnode; - Len : Int32; Val : Var_Type; Bound : Var_Type; R : O_Enode; begin -- Create the string value. - Len := Get_String_Length (Str); Val := Create_String_Literal_Var (Str); if Type_Info.Type_Mode = Type_Mode_Fat_Array then @@ -400,20 +368,6 @@ package body Trans.Chap7 is return Res; end Translate_Static_String; - function Translate_Static_Bit_String_Literal (Lit : Iir_Bit_String_Literal) - return O_Cnode - is - Lit_Type : constant Iir := Get_Type (Lit); - Res : O_Cnode; - List : O_Array_Aggr_List; - begin - Chap3.Translate_Anonymous_Type_Definition (Lit_Type, True); - Start_Array_Aggr (List, Get_Ortho_Type (Lit_Type, Mode_Value)); - Translate_Static_Bit_String_Literal_Inner (List, Lit, Lit_Type); - Finish_Array_Aggr (List, Res); - return Res; - end Translate_Static_Bit_String_Literal; - function Translate_String_Literal (Str : Iir) return O_Enode is Str_Type : constant Iir := Get_Type (Str); @@ -427,10 +381,8 @@ package body Trans.Chap7 is then Chap3.Create_Array_Subtype (Str_Type, True); case Get_Kind (Str) is - when Iir_Kind_String_Literal => - Res := Translate_Static_String_Literal (Str); - when Iir_Kind_Bit_String_Literal => - Res := Translate_Static_Bit_String_Literal (Str); + when Iir_Kind_String_Literal8 => + Res := Translate_Static_String_Literal8 (Str); when Iir_Kind_Simple_Aggregate => Res := Translate_Static_Simple_Aggregate (Str); when Iir_Kind_Simple_Name_Attribute => @@ -574,13 +526,9 @@ package body Trans.Chap7 is | Iir_Kind_Physical_Fp_Literal => return Translate_Numeric_Literal (Expr, Res_Type); - when Iir_Kind_String_Literal => + when Iir_Kind_String_Literal8 => return Translate_Static_Implicit_Conv - (Translate_Static_String_Literal (Expr), Expr_Type, Res_Type); - when Iir_Kind_Bit_String_Literal => - return Translate_Static_Implicit_Conv - (Translate_Static_Bit_String_Literal (Expr), - Expr_Type, Res_Type); + (Translate_Static_String_Literal8 (Expr), Expr_Type, Res_Type); when Iir_Kind_Simple_Aggregate => return Translate_Static_Implicit_Conv (Translate_Static_Simple_Aggregate (Expr), @@ -2795,8 +2743,7 @@ package body Trans.Chap7 is -- Stop when a sub-aggregate is in fact an aggregate. return Aggr1; end if; - when Iir_Kind_String_Literal - | Iir_Kind_Bit_String_Literal => + when Iir_Kind_String_Literal8 => return Null_Iir; --Error_Kind ("is_aggregate_others", Aggr1); when others => @@ -2894,8 +2841,7 @@ package body Trans.Chap7 is when Iir_Kind_Aggregate => -- Continue below. null; - when Iir_Kind_String_Literal - | Iir_Kind_Bit_String_Literal => + when Iir_Kind_String_Literal8 => declare Len : constant Nat32 := Get_String_Length (Aggr); @@ -3859,8 +3805,7 @@ package body Trans.Chap7 is end if; end; - when Iir_Kind_String_Literal - | Iir_Kind_Bit_String_Literal + when Iir_Kind_String_Literal8 | Iir_Kind_Simple_Aggregate | Iir_Kind_Simple_Name_Attribute => Res := Translate_String_Literal (Expr); diff --git a/src/vhdl/translate/translation.adb b/src/vhdl/translate/translation.adb index 7ba0085e1..164a2e5a4 100644 --- a/src/vhdl/translate/translation.adb +++ b/src/vhdl/translate/translation.adb @@ -22,6 +22,7 @@ with Ada.Text_IO; with Types; use Types; with Errorout; use Errorout; with Name_Table; -- use Name_Table; +with Str_Table; with Files_Map; with Iirs_Utils; use Iirs_Utils; with Std_Package; use Std_Package; @@ -76,14 +77,13 @@ package body Translation is Spec := Get_Attribute_Specification (Attr); Expr := Get_Expression (Spec); case Get_Kind (Expr) is - when Iir_Kind_String_Literal => + when Iir_Kind_String_Literal8 => declare - Ptr : String_Fat_Acc; + Id : constant String8_Id := Get_String8_Id (Expr); begin - Ptr := Get_String_Fat_Acc (Expr); Name_Length := Natural (Get_String_Length (Expr)); for I in 1 .. Name_Length loop - Name_Buffer (I) := Ptr (Nat32 (I)); + Name_Buffer (I) := Str_Table.Char_String8 (Id, Pos32 (I)); end loop; end; when Iir_Kind_Simple_Aggregate => @@ -104,10 +104,6 @@ package body Translation is Character'Val (Get_Enum_Pos (El)); end loop; end; - when Iir_Kind_Bit_String_Literal => - Error_Msg_Sem - ("value of FOREIGN attribute cannot be a bit string", Expr); - Name_Length := 0; when others => if Get_Expr_Staticness (Expr) /= Locally then Error_Msg_Sem -- cgit v1.2.3