diff options
author | Tristan Gingold <tgingold@free.fr> | 2018-01-18 20:42:28 +0100 |
---|---|---|
committer | Tristan Gingold <tgingold@free.fr> | 2018-01-20 07:40:52 +0100 |
commit | a883fc4125afc3e874dfa1e4a5817c01219e0db9 (patch) | |
tree | d12a68a7f85a2ddbca5bfeaa42ca6904fccad1ee /src/vhdl/translate | |
parent | 22961e664b8316941624d11b87fa003d010d34cf (diff) | |
download | ghdl-a883fc4125afc3e874dfa1e4a5817c01219e0db9.tar.gz ghdl-a883fc4125afc3e874dfa1e4a5817c01219e0db9.tar.bz2 ghdl-a883fc4125afc3e874dfa1e4a5817c01219e0db9.zip |
translation: remove some use of Nam_Buffer.
Diffstat (limited to 'src/vhdl/translate')
-rw-r--r-- | src/vhdl/translate/trans-chap2.adb | 4 | ||||
-rw-r--r-- | src/vhdl/translate/trans.adb | 164 | ||||
-rw-r--r-- | src/vhdl/translate/translation.adb | 84 | ||||
-rw-r--r-- | src/vhdl/translate/translation.ads | 9 |
4 files changed, 133 insertions, 128 deletions
diff --git a/src/vhdl/translate/trans-chap2.adb b/src/vhdl/translate/trans-chap2.adb index 672aeb1f9..f71b4ad10 100644 --- a/src/vhdl/translate/trans-chap2.adb +++ b/src/vhdl/translate/trans-chap2.adb @@ -16,7 +16,6 @@ -- Software Foundation, 59 Temple Place - Suite 330, Boston, MA -- 02111-1307, USA. -with Name_Table; with Std_Names; with Std_Package; use Std_Package; with Errorout; use Errorout; @@ -247,8 +246,7 @@ package body Trans.Chap2 is Id := Create_Identifier; when Foreign_Vhpidirect => Id := Get_Identifier - (Name_Table.Nam_Buffer (Foreign.Subprg_First - .. Foreign.Subprg_Last)); + (Foreign.Subprg_Name (1 .. Foreign.Subprg_Len)); end case; Storage := O_Storage_External; else diff --git a/src/vhdl/translate/trans.adb b/src/vhdl/translate/trans.adb index b298ad583..21ccb16c2 100644 --- a/src/vhdl/translate/trans.adb +++ b/src/vhdl/translate/trans.adb @@ -744,6 +744,12 @@ package body Trans is Add_String (Len, Num (P .. Num'Last)); end Add_Nat; + type Bool_Array_Type is array (Character) of Boolean; + pragma Pack (Bool_Array_Type); + Is_Extended_Char : constant Bool_Array_Type := + ('0' .. '9' | 'A' .. 'Z' | 'a' .. 'z' => False, + others => True); + -- Convert name_id NAME to a string stored to -- NAME_BUFFER (1 .. NAME_LENGTH). -- @@ -754,79 +760,77 @@ package body Trans is -- Non extended character [0-9a-zA-Z] are left as is, -- others are encoded to _XX, where XX is the character position in hex. -- They finish with "__". - procedure Name_Id_To_String (Name : Name_Id) - is - use Name_Table; - - type Bool_Array_Type is array (Character) of Boolean; - pragma Pack (Bool_Array_Type); - Is_Extended_Char : constant Bool_Array_Type := - ('0' .. '9' | 'A' .. 'Z' | 'a' .. 'z' => False, - others => True); - - N_Len : Natural; - P : Natural; - C : Character; - begin - if Is_Character (Name) then - P := Character'Pos (Name_Table.Get_Character (Name)); - Nam_Buffer (1) := 'C'; - Nam_Buffer (2) := N2hex (P / 16); - Nam_Buffer (3) := N2hex (P mod 16); - Nam_Length := 3; - return; + function Name_Id_To_String (Name : Name_Id) return String is + begin + if Name_Table.Is_Character (Name) then + declare + P : constant Natural := + Character'Pos (Name_Table.Get_Character (Name)); + Res : String (1 .. 3); + begin + Res (1) := 'C'; + Res (2) := N2hex (P / 16); + Res (3) := N2hex (P mod 16); + return Res; + end; else - Image (Name); - end if; - if Nam_Buffer (1) /= '\' then - return; - end if; - -- Extended identifier. - -- Supress trailing backslash. - Nam_Length := Nam_Length - 1; - - -- Count number of characters in the extended string. - N_Len := Nam_Length; - for I in 2 .. Nam_Length loop - if Is_Extended_Char (Nam_Buffer (I)) then - N_Len := N_Len + 2; - end if; - end loop; + declare + Img : constant String := Name_Table.Image (Name); + N_Len : Natural; + begin + if Img (Img'First) /= '\' then + return Img; + end if; - -- Convert. - Nam_Buffer (1) := 'X'; - P := N_Len; - for J in reverse 2 .. Nam_Length loop - C := Nam_Buffer (J); - if Is_Extended_Char (C) then - Nam_Buffer (P - 0) := N2hex (Character'Pos (C) mod 16); - Nam_Buffer (P - 1) := N2hex (Character'Pos (C) / 16); - Nam_Buffer (P - 2) := '_'; - P := P - 3; - else - Nam_Buffer (P) := C; - P := P - 1; - end if; - end loop; - Nam_Buffer (N_Len + 1) := '_'; - Nam_Buffer (N_Len + 2) := '_'; - Nam_Length := N_Len + 2; + -- Extended identifier. + + -- Count number of characters in the extended string. + N_Len := 3; + for I in Img'First + 1 .. Img'Last - 1 loop + if Is_Extended_Char (Img (I)) then + N_Len := N_Len + 3; + else + N_Len := N_Len + 1; + end if; + end loop; + + declare + Img2 : String (1 .. N_Len); + P : Natural; + C : Character; + begin + -- Convert (without the trailing backslash). + Img2 (1) := 'X'; + P := 1; + for I in Img'First + 1 .. Img'Last - 1 loop + C := Img (I); + if Is_Extended_Char (C) then + Img2 (P + 1) := '_'; + Img2 (P + 2) := N2hex (Character'Pos (C) / 16); + Img2 (P + 3) := N2hex (Character'Pos (C) mod 16); + P := P + 3; + else + Img2 (P + 1) := C; + P := P + 1; + end if; + end loop; + Img2 (P + 1) := '_'; + Img2 (P + 2) := '_'; + pragma Assert (N_Len = P + 2); + return Img2; + end; + end; + end if; end Name_Id_To_String; - function Identifier_To_String (N : Iir) return String - is - use Name_Table; + function Identifier_To_String (N : Iir) return String is begin - Name_Id_To_String (Get_Identifier (N)); - return Nam_Buffer (1 .. Nam_Length); + return Name_Id_To_String (Get_Identifier (N)); end Identifier_To_String; - procedure Add_Name (Len : in out Natural; Name : Name_Id) - is - use Name_Table; + procedure Add_Name (Len : in out Natural; Name : Name_Id) is begin - Name_Id_To_String (Name); - Add_String (Len, Nam_Buffer (1 .. Nam_Length)); + Add_String (Len, Name_Id_To_String (Name)); end Add_Name; procedure Push_Identifier_Prefix (Mark : out Id_Mark_Type; @@ -850,12 +854,13 @@ package body Trans is -- Add a suffix to the prefix (!!!). procedure Push_Identifier_Prefix - (Mark : out Id_Mark_Type; Name : Name_Id; Val : Iir_Int32 := 0) - is - use Name_Table; + (Mark : out Id_Mark_Type; Name : Name_Id; Val : Iir_Int32 := 0) is begin - Name_Id_To_String (Name); - Push_Identifier_Prefix (Mark, Nam_Buffer (1 .. Nam_Length), Val); + if Name = Null_Identifier then + Push_Identifier_Prefix (Mark, "", Val); + else + Push_Identifier_Prefix (Mark, Name_Id_To_String (Name), Val); + end if; end Push_Identifier_Prefix; procedure Push_Identifier_Prefix_Uniq (Mark : out Id_Mark_Type) @@ -875,22 +880,19 @@ package body Trans is end Add_Identifier; -- Create an identifier from IIR node ID without the prefix. - function Create_Identifier_Without_Prefix (Id : Iir) return O_Ident - is - use Name_Table; + function Create_Identifier_Without_Prefix (Id : Iir) return O_Ident is begin - Name_Id_To_String (Get_Identifier (Id)); - return Get_Identifier (Nam_Buffer (1 .. Nam_Length)); + return Get_Identifier (Name_Id_To_String (Get_Identifier (Id))); end Create_Identifier_Without_Prefix; function Create_Identifier_Without_Prefix (Id : Name_Id; Str : String) - return O_Ident - is - use Name_Table; + return O_Ident is begin - Name_Id_To_String (Id); - Nam_Buffer (Nam_Length + 1 .. Nam_Length + Str'Length) := Str; - return Get_Identifier (Nam_Buffer (1 .. Nam_Length + Str'Length)); + if Str'Length = 0 then + return Get_Identifier (Name_Id_To_String (Id)); + else + return Get_Identifier (Name_Id_To_String (Id) & Str); + end if; end Create_Identifier_Without_Prefix; function Create_Identifier_Without_Prefix diff --git a/src/vhdl/translate/translation.adb b/src/vhdl/translate/translation.adb index 9c3a3e2a5..7c7e1904e 100644 --- a/src/vhdl/translate/translation.adb +++ b/src/vhdl/translate/translation.adb @@ -63,62 +63,68 @@ package body Translation is end if; end Get_Resolv_Ortho_Decl; - function Translate_Foreign_Id (Decl : Iir) return Foreign_Info_Type - is - use Name_Table; - Attr : Iir_Attribute_Value; - Spec : Iir_Attribute_Specification; - Expr : Iir; + function Get_String_As_String (Expr : Iir) return String is begin - -- Look for 'FOREIGN. - Attr := Sem_Specs.Find_Attribute_Value (Decl, Std_Names.Name_Foreign); - pragma Assert (Attr /= Null_Iir); - - Spec := Get_Attribute_Specification (Attr); - Expr := Get_Expression (Spec); case Get_Kind (Expr) is when Iir_Kind_String_Literal8 => declare + Len : constant Natural := Natural (Get_String_Length (Expr)); Id : constant String8_Id := Get_String8_Id (Expr); + Res : String (1 .. Len); begin - Nam_Length := Natural (Get_String_Length (Expr)); - for I in 1 .. Nam_Length loop - Nam_Buffer (I) := Str_Table.Char_String8 (Id, Pos32 (I)); + for I in 1 .. Len loop + Res (I) := Str_Table.Char_String8 (Id, Pos32 (I)); end loop; + return Res; end; when Iir_Kind_Simple_Aggregate => declare List : constant Iir_Flist := Get_Simple_Aggregate_List (Expr); + Len : constant Natural := Get_Nbr_Elements (List); + Res : String (1 .. Len); El : Iir; begin - Nam_Length := 0; for I in Flist_First .. Flist_Last (List) loop El := Get_Nth_Element (List, I); pragma Assert (Get_Kind (El) = Iir_Kind_Enumeration_Literal); - Nam_Length := Nam_Length + 1; - Nam_Buffer (Nam_Length) := + Res (I - Flist_First + 1) := Character'Val (Get_Enum_Pos (El)); end loop; + return Res; end; when others => if Get_Expr_Staticness (Expr) /= Locally then Error_Msg_Sem (+Expr, "value of FOREIGN attribute must be locally static"); - Nam_Length := 0; + return ""; else raise Internal_Error; end if; end case; + end Get_String_As_String; - if Nam_Length = 0 then + function Translate_Foreign_Id (Decl : Iir) return Foreign_Info_Type + is + use Name_Table; + -- Look for 'FOREIGN. + Attr : constant Iir_Attribute_Value := + Sem_Specs.Find_Attribute_Value (Decl, Std_Names.Name_Foreign); + pragma Assert (Attr /= Null_Iir); + Spec : constant Iir_Attribute_Specification := + Get_Attribute_Specification (Attr); + Name : constant String := Get_String_As_String (Get_Expression (Spec)); + Length : constant Natural := Name'Length; + begin + if Length = 0 then return Foreign_Bad; end if; + pragma Assert (Name'First = 1); + -- Only 'VHPIDIRECT' is recognized. - if Nam_Length >= 10 - and then Nam_Buffer (1 .. 10) = "VHPIDIRECT" - then + if Length >= 10 and then Name (1 .. 10) = "VHPIDIRECT" then declare + Info : Foreign_Info_Type (Foreign_Vhpidirect); P : Natural; Sf, Sl : Natural; Lf, Ll : Natural; @@ -126,50 +132,50 @@ package body Translation is P := 11; -- Skip spaces. - while P <= Nam_Length and then Nam_Buffer (P) = ' ' loop + while P <= Length and then Name (P) = ' ' loop P := P + 1; end loop; - if P > Nam_Length then + if P > Length then Error_Msg_Sem (+Spec, "missing subprogram/library name after VHPIDIRECT"); end if; -- Extract library. Lf := P; - while P < Nam_Length and then Nam_Buffer (P) /= ' ' loop + while P < Length and then Name (P) /= ' ' loop P := P + 1; end loop; Ll := P; -- Extract subprogram. P := P + 1; - while P <= Nam_Length and then Nam_Buffer (P) = ' ' loop + while P <= Length and then Name (P) = ' ' loop P := P + 1; end loop; Sf := P; - while P < Nam_Length and then Nam_Buffer (P) /= ' ' loop + while P < Length and then Name (P) /= ' ' loop P := P + 1; end loop; Sl := P; - if P < Nam_Length then + if P < Length then Error_Msg_Sem (+Spec, "garbage at end of VHPIDIRECT"); end if; -- Accept empty library. - if Sf > Nam_Length then + if Sf > Length then Sf := Lf; Sl := Ll; - Lf := 0; + Lf := 1; Ll := 0; end if; - return Foreign_Info_Type' - (Kind => Foreign_Vhpidirect, - Lib_First => Lf, - Lib_Last => Ll, - Subprg_First => Sf, - Subprg_Last => Sl); + Info.Lib_Len := Ll - Lf + 1; + Info.Lib_Name (1 .. Info.Lib_Len) := Name (Lf .. Ll); + + Info.Subprg_Len := Sl - Sf + 1; + Info.Subprg_Name (1 .. Info.Subprg_Len) := Name (Sf .. Sl); + return Info; end; - elsif Nam_Length = 14 - and then Nam_Buffer (1 .. 14) = "GHDL intrinsic" + elsif Length = 14 + and then Name (1 .. 14) = "GHDL intrinsic" then return Foreign_Info_Type'(Kind => Foreign_Intrinsic); else diff --git a/src/vhdl/translate/translation.ads b/src/vhdl/translate/translation.ads index 37a8c72df..2228f8973 100644 --- a/src/vhdl/translate/translation.ads +++ b/src/vhdl/translate/translation.ads @@ -91,11 +91,10 @@ package Translation is when Foreign_Unknown => null; when Foreign_Vhpidirect => - -- Positions in name_table.name_buffer. - Lib_First : Natural; - Lib_Last : Natural; - Subprg_First : Natural; - Subprg_Last : Natural; + Lib_Name : String (1 .. 32); + Lib_Len : Natural; + Subprg_Name : String (1 .. 64); + Subprg_Len : Natural; when Foreign_Intrinsic => null; end case; |