diff options
author | Tristan Gingold <tgingold@free.fr> | 2019-11-23 18:49:56 +0100 |
---|---|---|
committer | Tristan Gingold <tgingold@free.fr> | 2019-11-23 18:49:56 +0100 |
commit | 8151d6391420e861095b85bd00a371eaf5682c2a (patch) | |
tree | 3e071b75e5a022d4046bc4020628ef1afe022ed6 | |
parent | 185e18dbf9d1c78eafc13c4824c8eab2fd686e12 (diff) | |
download | ghdl-8151d6391420e861095b85bd00a371eaf5682c2a.tar.gz ghdl-8151d6391420e861095b85bd00a371eaf5682c2a.tar.bz2 ghdl-8151d6391420e861095b85bd00a371eaf5682c2a.zip |
vhdl: recognize intrinsic procedures in vhdl-sem_specs.
Fix synth failures for llvm and gcc backends.
-rw-r--r-- | src/vhdl/translate/trans_be.adb | 21 | ||||
-rw-r--r-- | src/vhdl/vhdl-sem_specs.adb | 55 |
2 files changed, 51 insertions, 25 deletions
diff --git a/src/vhdl/translate/trans_be.adb b/src/vhdl/translate/trans_be.adb index 4092243ac..d4002cbcf 100644 --- a/src/vhdl/translate/trans_be.adb +++ b/src/vhdl/translate/trans_be.adb @@ -17,7 +17,6 @@ -- 02111-1307, USA. with Simple_IO; -with Std_Names; with Vhdl.Errors; use Vhdl.Errors; with Vhdl.Back_End; @@ -39,26 +38,6 @@ package body Trans_Be is -- Let it generate error messages. Fi := Translate_Foreign_Id (Decl); - if Fi.Kind = Foreign_Intrinsic then - pragma Assert (Get_Implicit_Definition (Decl) = Iir_Predefined_None); - declare - use Std_Names; - Predefined : Iir_Predefined_Functions; - begin - case Get_Identifier (Decl) is - when Name_Untruncated_Text_Read => - Predefined := Iir_Predefined_Foreign_Untruncated_Text_Read; - when Name_Textio_Read_Real => - Predefined := Iir_Predefined_Foreign_Textio_Read_Real; - when Name_Textio_Write_Real => - Predefined := Iir_Predefined_Foreign_Textio_Write_Real; - when others => - Predefined := Iir_Predefined_None; - end case; - Set_Implicit_Definition (Decl, Predefined); - end; - end if; - if Sem_Foreign_Hook /= null then Sem_Foreign_Hook.all (Decl, Fi); end if; diff --git a/src/vhdl/vhdl-sem_specs.adb b/src/vhdl/vhdl-sem_specs.adb index b5860ae9f..4e5ffb679 100644 --- a/src/vhdl/vhdl-sem_specs.adb +++ b/src/vhdl/vhdl-sem_specs.adb @@ -15,21 +15,23 @@ -- 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 Flags; use Flags; +with Std_Names; +with Str_Table; +with Libraries; +with Errorout; use Errorout; + with Vhdl.Utils; use Vhdl.Utils; with Vhdl.Sem_Expr; use Vhdl.Sem_Expr; with Vhdl.Sem_Names; use Vhdl.Sem_Names; with Vhdl.Evaluation; use Vhdl.Evaluation; with Vhdl.Std_Package; use Vhdl.Std_Package; -with Errorout; use Errorout; with Vhdl.Errors; use Vhdl.Errors; with Vhdl.Sem; use Vhdl.Sem; with Vhdl.Sem_Lib; use Vhdl.Sem_Lib; with Vhdl.Sem_Scopes; use Vhdl.Sem_Scopes; with Vhdl.Sem_Assocs; use Vhdl.Sem_Assocs; -with Libraries; with Vhdl.Nodes_Utils; use Vhdl.Nodes_Utils; -with Flags; use Flags; -with Std_Names; with Vhdl.Sem_Decls; with Vhdl.Xrefs; use Vhdl.Xrefs; with Vhdl.Back_End; @@ -177,6 +179,49 @@ package body Vhdl.Sem_Specs is return Null_Iir; end Find_Attribute_Value; + -- Called for 'Foreign attribute ATTR on procedure DECL. + -- Handle intrinsic subprograms. + procedure Attribute_Foreign_Procedure (Decl : Iir; Attr : Iir) + is + Expr : constant Iir := Get_Expression (Attr); + Intrinsic_Str : constant String := "GHDL intrinsic"; + Str_Id : String8_Id; + begin + -- Intrinsic must use a simple string literal. + if Get_Kind (Expr) /= Iir_Kind_String_Literal8 then + return; + end if; + + -- Compare with the string. + if Get_String_Length (Expr) /= Intrinsic_Str'Length then + return; + end if; + Str_Id := Get_String8_Id (Expr); + if Str_Table.String_String8 (Str_Id, Intrinsic_Str'Length) + /= Intrinsic_Str + then + return; + end if; + + pragma Assert (Get_Implicit_Definition (Decl) = Iir_Predefined_None); + declare + use Std_Names; + Predefined : Iir_Predefined_Functions; + begin + case Get_Identifier (Decl) is + when Name_Untruncated_Text_Read => + Predefined := Iir_Predefined_Foreign_Untruncated_Text_Read; + when Name_Textio_Read_Real => + Predefined := Iir_Predefined_Foreign_Textio_Read_Real; + when Name_Textio_Write_Real => + Predefined := Iir_Predefined_Foreign_Textio_Write_Real; + when others => + Predefined := Iir_Predefined_None; + end case; + Set_Implicit_Definition (Decl, Predefined); + end; + end Attribute_Foreign_Procedure; + -- Decorate DECL with attribute ATTR. -- If CHECK_CLASS is true, class of DECL must be class of ATTR, otherwise -- returns silently. @@ -355,6 +400,8 @@ package body Vhdl.Sem_Specs is -- consequence they cannot be suspended. if Get_Kind (Decl) = Iir_Kind_Procedure_Declaration then Set_Suspend_Flag (Decl, False); + + Attribute_Foreign_Procedure (Decl, Attr); end if; declare |