summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorTristan Gingold2014-12-29 08:20:50 +0100
committerTristan Gingold2014-12-29 08:20:50 +0100
commit17082aaf70426f2204b4259e45b1ca6e315bd439 (patch)
treee92e12bf92c6b6c4e52d92981ce75d430750d225
parentf77be8349e5c0d5924222af0c5fc059c6ae5b271 (diff)
downloadghdl-17082aaf70426f2204b4259e45b1ca6e315bd439.tar.gz
ghdl-17082aaf70426f2204b4259e45b1ca6e315bd439.tar.bz2
ghdl-17082aaf70426f2204b4259e45b1ca6e315bd439.zip
Rework string literals: store literals position.
Diffstat
-rw-r--r--src/files_map.adb111
-rw-r--r--src/libraries.adb9
-rw-r--r--src/str_table.adb91
-rw-r--r--src/str_table.ads42
-rw-r--r--src/types.ads18
-rw-r--r--src/vhdl/disp_tree.adb8
-rw-r--r--src/vhdl/disp_vhdl.adb40
-rw-r--r--src/vhdl/errorout.adb8
-rw-r--r--src/vhdl/evaluation.adb235
-rw-r--r--src/vhdl/iirs.adb67
-rw-r--r--src/vhdl/iirs.adb.in8
-rw-r--r--src/vhdl/iirs.ads75
-rw-r--r--src/vhdl/iirs_utils.adb17
-rw-r--r--src/vhdl/iirs_utils.ads4
-rw-r--r--src/vhdl/nodes.ads6
-rw-r--r--src/vhdl/nodes_meta.adb576
-rw-r--r--src/vhdl/nodes_meta.ads18
-rw-r--r--src/vhdl/parse.adb58
-rw-r--r--src/vhdl/scanner.adb172
-rw-r--r--src/vhdl/scanner.ads4
-rw-r--r--src/vhdl/sem.adb20
-rw-r--r--src/vhdl/sem_expr.adb98
-rw-r--r--src/vhdl/sem_inst.adb4
-rw-r--r--src/vhdl/sem_names.adb3
-rw-r--r--src/vhdl/std_package.adb5
-rw-r--r--src/vhdl/translate/trans-chap2.adb2
-rw-r--r--src/vhdl/translate/trans-chap4.adb2
-rw-r--r--src/vhdl/translate/trans-chap7.adb97
-rw-r--r--src/vhdl/translate/translation.adb12
29 files changed, 775 insertions, 1035 deletions
diff --git a/src/files_map.adb b/src/files_map.adb
index 7071520..22c33e4 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 9bc2327..8356546 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 32a44b5..85f7700 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 de65070..7be2656 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 571e11b..2fa4b3a 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 ad3c199..f8cc5d6 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 ("<string8>");
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 90338af..b8ca9f4 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 b78bfc2..940b8fc 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 bf9c6ba..4093b94 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 37f73c6..1462bb3 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 d8e8bc0..481a355 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 2ce529f..6d3c45a 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 2d84983..99737c4 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 da3e72b..3d74aa3 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 3c72b18..92a173f 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 e6c5b7d..9890310 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 7ce120a..a120a76 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 0611fc5..dedcee1 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 b480533..632e240 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 ddc0d18..3edc9c0 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 8a0c033..a8cbbd4 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 9a31452..16add4f 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 3f5891e..4993c83 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 5a1c123..47b9aa2 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 5f65aa2..54ec4e0 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 dc7807f..eee4254 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 b6f1c66..7c71cc7 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 ef0e53a..9660880 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 7ba0085..164a2e5 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
generated by cgit (git 2.34.1) at 2024-12-20 07:35:51 +0000