From 694a4d2744f252b326121c37c2271133e0ec535f Mon Sep 17 00:00:00 2001 From: Tristan Gingold Date: Mon, 21 Jul 2014 07:47:19 +0200 Subject: Add overflow literal. --- translate/ghdldrv/ghdllocal.adb | 84 +++++++++++++++++++++++------------------ translate/ghdldrv/ghdllocal.ads | 4 ++ translate/ghdldrv/ghdlprint.adb | 51 ++++++++++++++++++++++++- translate/ghdldrv/ghdlrun.adb | 2 - 4 files changed, 101 insertions(+), 40 deletions(-) (limited to 'translate/ghdldrv') diff --git a/translate/ghdldrv/ghdllocal.adb b/translate/ghdldrv/ghdllocal.adb index 7169fa32a..6459f70dd 100644 --- a/translate/ghdldrv/ghdllocal.adb +++ b/translate/ghdldrv/ghdllocal.adb @@ -34,6 +34,7 @@ with Files_Map; with Post_Sems; with Disp_Tree; with Options; +with Iirs_Utils; use Iirs_Utils; package body Ghdllocal is -- Version of the IEEE library to use. This just change pathes. @@ -273,12 +274,12 @@ package body Ghdllocal is case Get_Kind (Unit) is when Iir_Kind_Architecture_Body => Put (" of "); - Image (Get_Identifier (Get_Entity (Unit))); + Image (Get_Entity_Identifier_Of_Architecture (Unit)); Put (Name_Buffer (1 .. Name_Length)); when Iir_Kind_Configuration_Declaration => if Id = Null_Identifier then Put (" of entity "); - Image (Get_Identifier (Get_Library_Unit (Get_Entity (Unit)))); + Image (Get_Entity_Identifier_Of_Architecture (Unit)); Put (Name_Buffer (1 .. Name_Length)); end if; when others => @@ -580,7 +581,7 @@ package body Ghdllocal is return "-s [OPTS] FILEs Check syntax of FILEs"; end Get_Short_Help; - procedure Analyze_Files (Files : Argument_List; Save_Library : Boolean) + function Analyze_One_File (File_Name : String) return Iir_Design_File is use Ada.Text_IO; Id : Name_Id; @@ -588,40 +589,52 @@ package body Ghdllocal is Unit : Iir; Next_Unit : Iir; begin - Setup_Libraries (True); + Id := Name_Table.Get_Identifier (File_Name); + if Flag_Verbose then + Put (File_Name); + Put_Line (":"); + end if; + Design_File := Libraries.Load_File (Id); + if Design_File = Null_Iir then + raise Errorout.Compilation_Error; + end if; - -- Parse all files. - for I in Files'Range loop - Id := Name_Table.Get_Identifier (Files (I).all); + Unit := Get_First_Design_Unit (Design_File); + while Unit /= Null_Iir loop if Flag_Verbose then - Put (Files (I).all); - Put_Line (":"); + Put (' '); + Disp_Library_Unit (Get_Library_Unit (Unit)); + New_Line; end if; - Design_File := Libraries.Load_File (Id); - if Design_File /= Null_Iir then - Unit := Get_First_Design_Unit (Design_File); - while Unit /= Null_Iir loop - if Flag_Verbose then - Put (' '); - Disp_Library_Unit (Get_Library_Unit (Unit)); - New_Line; - end if; - -- Sem, canon, annotate a design unit. - Back_End.Finish_Compilation (Unit, True); + -- Sem, canon, annotate a design unit. + Back_End.Finish_Compilation (Unit, True); - Next_Unit := Get_Chain (Unit); - if Errorout.Nbr_Errors = 0 then - Set_Chain (Unit, Null_Iir); - Libraries.Add_Design_Unit_Into_Library (Unit); - end if; + Next_Unit := Get_Chain (Unit); + if Errorout.Nbr_Errors = 0 then + Set_Chain (Unit, Null_Iir); + Libraries.Add_Design_Unit_Into_Library (Unit); + end if; - Unit := Next_Unit; - end loop; + Unit := Next_Unit; + end loop; - if Errorout.Nbr_Errors > 0 then - raise Errorout.Compilation_Error; - end if; - end if; + if Errorout.Nbr_Errors > 0 then + raise Errorout.Compilation_Error; + end if; + + return Design_File; + end Analyze_One_File; + + procedure Analyze_Files (Files : Argument_List; Save_Library : Boolean) + is + Design_File : Iir_Design_File; + pragma Unreferenced (Design_File); + begin + Setup_Libraries (True); + + -- Parse all files. + for I in Files'Range loop + Design_File := Analyze_One_File (Files (I).all); end loop; if Save_Library then @@ -694,7 +707,6 @@ package body Ghdllocal is File : Iir_Design_File; Design_Unit : Iir_Design_Unit; Lib_Unit : Iir; - Ent_Unit : Iir; Str : String_Access; begin if Args'Length /= 0 then @@ -722,10 +734,10 @@ package body Ghdllocal is | Iir_Kind_Configuration_Declaration => Delete_Top_Unit (Image (Get_Identifier (Lib_Unit))); when Iir_Kind_Architecture_Body => - Ent_Unit := Get_Entity (Lib_Unit); - Delete_Top_Unit (Image (Get_Identifier (Ent_Unit)) - & '-' - & Image (Get_Identifier (Lib_Unit))); + Delete_Top_Unit + (Image (Get_Entity_Identifier_Of_Architecture (Lib_Unit)) + & '-' + & Image (Get_Identifier (Lib_Unit))); when others => null; end case; diff --git a/translate/ghdldrv/ghdllocal.ads b/translate/ghdldrv/ghdllocal.ads index 46eff1a14..f197038c3 100644 --- a/translate/ghdldrv/ghdllocal.ads +++ b/translate/ghdldrv/ghdllocal.ads @@ -84,6 +84,10 @@ package Ghdllocal is -- Setup standard libaries path. If LOAD is true, then load them now. procedure Setup_Libraries (Load : Boolean); + -- Analyze file FILE_NAME. Raise Compilation_Error in case of analysis + -- error. + function Analyze_One_File (File_Name : String) return Iir_Design_File; + -- Setup library, analyze FILES, and if SAVE_LIBRARY is set save the -- work library only procedure Analyze_Files (Files : Argument_List; Save_Library : Boolean); diff --git a/translate/ghdldrv/ghdlprint.adb b/translate/ghdldrv/ghdlprint.adb index 0b775760e..214f03009 100644 --- a/translate/ghdldrv/ghdlprint.adb +++ b/translate/ghdldrv/ghdlprint.adb @@ -26,12 +26,14 @@ with Files_Map; with Libraries; with Errorout; use Errorout; with Iirs; use Iirs; +with Iirs_Utils; use Iirs_Utils; with Tokens; with Scanner; with Version; with Xrefs; with Ghdlmain; use Ghdlmain; with Ghdllocal; use Ghdllocal; +with Disp_Vhdl; package body Ghdlprint is type Html_Format_Type is (Html_2, Html_Css); @@ -566,7 +568,7 @@ package body Ghdlprint is when Iir_Kind_Package_Body => Len := Len + 1 + 4; -- add -body when Iir_Kind_Architecture_Body => - Id1 := Get_Identifier (Get_Entity (Lib)); + Id1 := Get_Entity_Identifier_Of_Architecture (Lib); Len := Len + 1 + Get_Name_Length (Id1); when others => Error_Kind ("build_file_name", Lib); @@ -599,7 +601,7 @@ package body Ghdlprint is Append (Name_Buffer (1 .. Name_Length)); Append ("-body"); when Iir_Kind_Architecture_Body => - Image (Get_Identifier (Get_Entity (Lib))); + Image (Get_Entity_Identifier_Of_Architecture (Lib)); Append (Name_Buffer (1 .. Name_Length)); Append ("-"); Image (Id); @@ -938,6 +940,50 @@ package body Ghdlprint is end loop; end Perform_Action; + -- Command Reprint. + type Command_Reprint is new Command_Lib with null record; + function Decode_Command (Cmd : Command_Reprint; Name : String) + return Boolean; + function Get_Short_Help (Cmd : Command_Reprint) return String; + procedure Perform_Action (Cmd : in out Command_Reprint; + Args : Argument_List); + + function Decode_Command (Cmd : Command_Reprint; Name : String) + return Boolean + is + pragma Unreferenced (Cmd); + begin + return Name = "--reprint"; + end Decode_Command; + + function Get_Short_Help (Cmd : Command_Reprint) return String + is + pragma Unreferenced (Cmd); + begin + return "--reprint [OPTS] FILEs Redisplay FILEs"; + end Get_Short_Help; + + procedure Perform_Action (Cmd : in out Command_Reprint; + Args : Argument_List) + is + pragma Unreferenced (Cmd); + Design_File : Iir_Design_File; + Unit : Iir; + begin + Setup_Libraries (True); + + -- Parse all files. + for I in Args'Range loop + Design_File := Analyze_One_File (Args (I).all); + Unit := Get_First_Design_Unit (Design_File); + while Unit /= Null_Iir loop + Disp_Vhdl.Disp_Vhdl (Unit); + Unit := Get_Chain (Unit); + end loop; + end loop; + end Perform_Action; + + -- Command html. type Command_Html is abstract new Command_Lib with null record; procedure Decode_Option (Cmd : in out Command_Html; @@ -1569,6 +1615,7 @@ package body Ghdlprint is begin Register_Command (new Command_Chop); Register_Command (new Command_Lines); + Register_Command (new Command_Reprint); Register_Command (new Command_PP_Html); Register_Command (new Command_Xref_Html); Register_Command (new Command_Xref); diff --git a/translate/ghdldrv/ghdlrun.adb b/translate/ghdldrv/ghdlrun.adb index 676c82824..cded35158 100644 --- a/translate/ghdldrv/ghdlrun.adb +++ b/translate/ghdldrv/ghdlrun.adb @@ -240,8 +240,6 @@ package body Ghdlrun is Def (Trans_Decls.Ghdl_Memcpy, Grt.Lib.Ghdl_Memcpy'Address); - Def (Trans_Decls.Ghdl_Bound_Check_Failed_L0, - Grt.Lib.Ghdl_Bound_Check_Failed_L0'Address); Def (Trans_Decls.Ghdl_Bound_Check_Failed_L1, Grt.Lib.Ghdl_Bound_Check_Failed_L1'Address); Def (Trans_Decls.Ghdl_Malloc0, -- cgit v1.2.3