diff options
Diffstat (limited to 'translate')
| -rw-r--r-- | translate/ghdldrv/ghdllocal.adb | 11 | ||||
| -rw-r--r-- | translate/ghdldrv/ghdllocal.ads | 4 | ||||
| -rw-r--r-- | translate/ghdldrv/ghdlprint.adb | 126 |
3 files changed, 126 insertions, 15 deletions
diff --git a/translate/ghdldrv/ghdllocal.adb b/translate/ghdldrv/ghdllocal.adb index 6459f70..a94b279 100644 --- a/translate/ghdldrv/ghdllocal.adb +++ b/translate/ghdldrv/ghdllocal.adb @@ -581,7 +581,7 @@ package body Ghdllocal is return "-s [OPTS] FILEs Check syntax of FILEs"; end Get_Short_Help; - function Analyze_One_File (File_Name : String) return Iir_Design_File + procedure Analyze_One_File (File_Name : String) is use Ada.Text_IO; Id : Name_Id; @@ -621,20 +621,15 @@ package body Ghdllocal is 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); + procedure Analyze_Files (Files : Argument_List; Save_Library : Boolean) is begin Setup_Libraries (True); -- Parse all files. for I in Files'Range loop - Design_File := Analyze_One_File (Files (I).all); + Analyze_One_File (Files (I).all); end loop; if Save_Library then diff --git a/translate/ghdldrv/ghdllocal.ads b/translate/ghdldrv/ghdllocal.ads index f197038..46eff1a 100644 --- a/translate/ghdldrv/ghdllocal.ads +++ b/translate/ghdldrv/ghdllocal.ads @@ -84,10 +84,6 @@ 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 214f030..3af75f8 100644 --- a/translate/ghdldrv/ghdlprint.adb +++ b/translate/ghdldrv/ghdlprint.adb @@ -19,6 +19,7 @@ with Ada.Characters.Latin_1; with Ada.Text_IO; use Ada.Text_IO; with GNAT.Directory_Operations; with GNAT.OS_Lib; use GNAT.OS_Lib; +with GNAT.Table; with Types; use Types; with Flags; with Name_Table; use Name_Table; @@ -29,11 +30,13 @@ with Iirs; use Iirs; with Iirs_Utils; use Iirs_Utils; with Tokens; with Scanner; +with Parse; with Version; with Xrefs; with Ghdlmain; use Ghdlmain; with Ghdllocal; use Ghdllocal; with Disp_Vhdl; +with Back_End; package body Ghdlprint is type Html_Format_Type is (Html_2, Html_Css); @@ -969,20 +972,136 @@ package body Ghdlprint is pragma Unreferenced (Cmd); Design_File : Iir_Design_File; Unit : Iir; + + Id : Name_Id; + Next_Unit : Iir; begin Setup_Libraries (True); + Parse.Flag_Parse_Parenthesis := True; -- Parse all files. for I in Args'Range loop - Design_File := Analyze_One_File (Args (I).all); + Id := Name_Table.Get_Identifier (Args (I).all); + Design_File := Libraries.Load_File (Id); + if Design_File = Null_Iir then + raise Errorout.Compilation_Error; + end if; + Unit := Get_First_Design_Unit (Design_File); while Unit /= Null_Iir loop - Disp_Vhdl.Disp_Vhdl (Unit); - Unit := Get_Chain (Unit); + -- Sem, canon, annotate a design unit. + Back_End.Finish_Compilation (Unit, True); + + Next_Unit := Get_Chain (Unit); + if Errorout.Nbr_Errors = 0 then + Disp_Vhdl.Disp_Vhdl (Unit); + Set_Chain (Unit, Null_Iir); + Libraries.Add_Design_Unit_Into_Library (Unit); + end if; + + Unit := Next_Unit; end loop; + + if Errorout.Nbr_Errors > 0 then + raise Errorout.Compilation_Error; + end if; end loop; end Perform_Action; + -- Command compare tokens. + type Command_Compare_Tokens is new Command_Lib with null record; + function Decode_Command (Cmd : Command_Compare_Tokens; Name : String) + return Boolean; + function Get_Short_Help (Cmd : Command_Compare_Tokens) return String; + procedure Perform_Action (Cmd : in out Command_Compare_Tokens; + Args : Argument_List); + + function Decode_Command (Cmd : Command_Compare_Tokens; Name : String) + return Boolean + is + pragma Unreferenced (Cmd); + begin + return Name = "--compare-tokens"; + end Decode_Command; + + function Get_Short_Help (Cmd : Command_Compare_Tokens) return String + is + pragma Unreferenced (Cmd); + begin + return "--compare-tokens [OPTS] REF FILEs Compare FILEs with REF"; + end Get_Short_Help; + + procedure Perform_Action (Cmd : in out Command_Compare_Tokens; + Args : Argument_List) + is + pragma Unreferenced (Cmd); + use Tokens; + use Scanner; + + package Ref_Tokens is new GNAT.Table + (Table_Component_Type => Token_Type, + Table_Index_Type => Integer, + Table_Low_Bound => 0, + Table_Initial => 1024, + Table_Increment => 100); + + Id : Name_Id; + Fe : Source_File_Entry; + Local_Id : Name_Id; + Tok_Idx : Natural; + begin + if Args'Length < 1 then + Error ("missing ref file"); + raise Compile_Error; + end if; + + Local_Id := Get_Identifier (""); + + for I in Args'Range loop + -- Load the file. + Id := Get_Identifier (Args (I).all); + Fe := Files_Map.Load_Source_File (Local_Id, Id); + if Fe = No_Source_File_Entry then + Error ("cannot open file " & Args (I).all); + raise Compile_Error; + end if; + Set_File (Fe); + + if I = Args'First then + -- Scan ref file + loop + Scan; + Ref_Tokens.Append (Current_Token); + exit when Current_Token = Tok_Eof; + end loop; + else + -- Scane file + Tok_Idx := Ref_Tokens.First; + loop + Scan; + if Ref_Tokens.Table (Tok_Idx) /= Current_Token then + Error_Msg_Parse ("token mismatch"); + exit; + end if; + case Current_Token is + when Tok_Eof => + exit; + when others => + null; + end case; + Tok_Idx := Tok_Idx + 1; + end loop; + end if; + Close_File; + end loop; + + Ref_Tokens.Free; + + if Nbr_Errors /= 0 then + raise Compilation_Error; + end if; + end Perform_Action; + -- Command html. type Command_Html is abstract new Command_Lib with null record; @@ -1616,6 +1735,7 @@ package body Ghdlprint is Register_Command (new Command_Chop); Register_Command (new Command_Lines); Register_Command (new Command_Reprint); + Register_Command (new Command_Compare_Tokens); Register_Command (new Command_PP_Html); Register_Command (new Command_Xref_Html); Register_Command (new Command_Xref); |