diff options
Diffstat (limited to 'src/ghdldrv')
| -rw-r--r-- | src/ghdldrv/ghdlcomp.adb | 15 | ||||
| -rw-r--r-- | src/ghdldrv/ghdllocal.adb | 90 | ||||
| -rw-r--r-- | src/ghdldrv/ghdlprint.adb | 10 | ||||
| -rw-r--r-- | src/ghdldrv/ghdlsimul.adb | 12 | ||||
| -rw-r--r-- | src/ghdldrv/ghdlxml.adb | 25 |
5 files changed, 35 insertions, 117 deletions
diff --git a/src/ghdldrv/ghdlcomp.adb b/src/ghdldrv/ghdlcomp.adb index 77aa4ebe7..18ed69380 100644 --- a/src/ghdldrv/ghdlcomp.adb +++ b/src/ghdldrv/ghdlcomp.adb @@ -24,9 +24,7 @@ with Ada.Text_IO; with Types; with Iirs; use Iirs; -with Nodes_GC; with Flags; -with Back_End; with Sem; with Name_Table; with Errorout; use Errorout; @@ -39,9 +37,6 @@ package body Ghdlcomp is Flag_Expect_Failure : Boolean := False; - Flag_Debug_Nodes_Leak : Boolean := False; - -- If True, detect unreferenced nodes at the end of analysis. - -- Commands which use the mcode compiler. type Command_Comp is abstract new Command_Lib with null record; procedure Decode_Option (Cmd : in out Command_Comp; @@ -59,8 +54,8 @@ package body Ghdlcomp is if Option = "--expect-failure" then Flag_Expect_Failure := True; Res := Option_Ok; - elsif Option = "--debug-nodes-leak" then - Flag_Debug_Nodes_Leak := True; + elsif Option = "--check-ast" then + Flags.Check_Ast_Level := Flags.Check_Ast_Level + 1; Res := Option_Ok; elsif Hooks.Decode_Option.all (Option) then Res := Option_Ok; @@ -341,7 +336,7 @@ package body Ghdlcomp is if Design_File /= Null_Iir then Unit := Get_First_Design_Unit (Design_File); while Unit /= Null_Iir loop - Back_End.Finish_Compilation (Unit, True); + Libraries.Finish_Compilation (Unit, True); Next_Unit := Get_Chain (Unit); @@ -378,10 +373,6 @@ package body Ghdlcomp is raise Compilation_Error; end if; - if Flag_Debug_Nodes_Leak then - Nodes_GC.Report_Unreferenced; - end if; - Libraries.Save_Work_Library; exception diff --git a/src/ghdldrv/ghdllocal.adb b/src/ghdldrv/ghdllocal.adb index b1050e5fe..411965374 100644 --- a/src/ghdldrv/ghdllocal.adb +++ b/src/ghdldrv/ghdllocal.adb @@ -19,24 +19,17 @@ with Ada.Text_IO; use Ada.Text_IO; with Ada.Command_Line; use Ada.Command_Line; with GNAT.Directory_Operations; with Types; use Types; -with Iir_Chains; -with Nodes_Meta; with Libraries; with Std_Package; with Flags; with Name_Table; with Std_Names; -with Back_End; with Disp_Vhdl; with Default_Pathes; with Scanner; -with Sem; -with Canon; with Errorout; with Configuration; with Files_Map; -with Post_Sems; -with Disp_Tree; with Options; with Iirs_Utils; use Iirs_Utils; @@ -48,89 +41,10 @@ package body Ghdllocal is -- If TRUE, generate 32bits code on 64bits machines. Flag_32bit : Boolean := False; - procedure Finish_Compilation - (Unit : Iir_Design_Unit; Main : Boolean := False) - is - use Errorout; - Lib_Unit : constant Iir := Get_Library_Unit (Unit); - Config : Iir_Design_Unit; - begin - if (Main or Flags.Dump_All) and then Flags.Dump_Parse then - Disp_Tree.Disp_Tree (Unit); - end if; - - if Flags.Verbose then - Report_Msg (Msgid_Note, Semantic, +Unit, - "analyze %n", (1 => +Lib_Unit)); - end if; - - Sem.Semantic (Unit); - - if (Main or Flags.Dump_All) and then Flags.Dump_Sem then - Disp_Tree.Disp_Tree (Unit); - end if; - - if Errorout.Nbr_Errors > 0 then - raise Compilation_Error; - end if; - - if (Main or Flags.List_All) and then Flags.List_Sem then - Disp_Vhdl.Disp_Vhdl (Unit); - end if; - - Post_Sems.Post_Sem_Checks (Unit); - - if Errorout.Nbr_Errors > 0 then - raise Compilation_Error; - end if; - - if Flags.Flag_Elaborate - or else ((Main or Flags.List_All) and then Flags.List_Canon) - then - if Flags.Verbose then - Report_Msg (Msgid_Note, Semantic, No_Location, - "canonicalize %n", (1 => +Lib_Unit)); - end if; - - Canon.Canonicalize (Unit); - - -- FIXME: for Main only ? - if Get_Kind (Lib_Unit) = Iir_Kind_Package_Declaration - and then not Get_Need_Body (Lib_Unit) - and then Get_Need_Instance_Bodies (Lib_Unit) - then - -- Create the bodies for instances - Set_Package_Instantiation_Bodies_Chain - (Lib_Unit, - Canon.Create_Instantiation_Bodies (Lib_Unit, Lib_Unit)); - elsif Get_Kind (Lib_Unit) = Iir_Kind_Package_Body - and then Get_Need_Instance_Bodies (Get_Package (Lib_Unit)) - then - Iir_Chains.Append_Chain - (Lib_Unit, Nodes_Meta.Field_Declaration_Chain, - Canon.Create_Instantiation_Bodies (Get_Package (Lib_Unit), - Lib_Unit)); - end if; - - if (Main or Flags.List_All) and then Flags.List_Canon then - Disp_Vhdl.Disp_Vhdl (Unit); - end if; - end if; - - if Flags.Flag_Elaborate then - if Get_Kind (Lib_Unit) = Iir_Kind_Architecture_Body then - Config := - Canon.Create_Default_Configuration_Declaration (Lib_Unit); - Set_Default_Configuration_Declaration (Lib_Unit, Config); - end if; - end if; - end Finish_Compilation; - procedure Compile_Init is begin Options.Initialize; Flag_Ieee := Lib_Standard; - Back_End.Finish_Compilation := Finish_Compilation'Access; Flag_Verbose := False; end Compile_Init; @@ -800,7 +714,7 @@ package body Ghdllocal is | Date_Analyzed => null; when Date_Parsed => - Back_End.Finish_Compilation (Unit, False); + Libraries.Finish_Compilation (Unit, False); when others => raise Internal_Error; end case; @@ -865,7 +779,7 @@ package body Ghdllocal is New_Line; end if; -- Sem, canon, annotate a design unit. - Back_End.Finish_Compilation (Unit, True); + Libraries.Finish_Compilation (Unit, True); Next_Unit := Get_Chain (Unit); if Errorout.Nbr_Errors = 0 then diff --git a/src/ghdldrv/ghdlprint.adb b/src/ghdldrv/ghdlprint.adb index d9c6165a8..093ba00a9 100644 --- a/src/ghdldrv/ghdlprint.adb +++ b/src/ghdldrv/ghdlprint.adb @@ -30,12 +30,12 @@ with Iirs_Utils; use Iirs_Utils; with Tokens; with Scanner; with Parse; +with Canon; 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); @@ -985,8 +985,14 @@ package body Ghdlprint is Next_Unit : Iir; begin Setup_Libraries (True); + + -- Keep parenthesis during parse. Parse.Flag_Parse_Parenthesis := True; + Canon.Canon_Flag_Concurrent_Stmts := False; + Canon.Canon_Flag_Configurations := False; + Canon.Canon_Flag_Specification_Lists := False; + -- Parse all files. for I in Args'Range loop Id := Name_Table.Get_Identifier (Args (I).all); @@ -998,7 +1004,7 @@ package body Ghdlprint is Unit := Get_First_Design_Unit (Design_File); while Unit /= Null_Iir loop -- Analyze the design unit. - Back_End.Finish_Compilation (Unit, True); + Libraries.Finish_Compilation (Unit, True); Next_Unit := Get_Chain (Unit); if Errorout.Nbr_Errors = 0 then diff --git a/src/ghdldrv/ghdlsimul.adb b/src/ghdldrv/ghdlsimul.adb index ddf70bbb3..2f2e13ce5 100644 --- a/src/ghdldrv/ghdlsimul.adb +++ b/src/ghdldrv/ghdlsimul.adb @@ -25,7 +25,6 @@ with GNAT.OS_Lib; use GNAT.OS_Lib; with Types; with Iirs; use Iirs; with Flags; -with Back_End; with Name_Table; with Errorout; use Errorout; with Std_Package; @@ -35,7 +34,6 @@ with Configuration; with Iirs_Utils; with Annotations; with Elaboration; -with Sim_Be; with Simulation.Main; with Debugger; with Execution; @@ -58,10 +56,6 @@ package body Ghdlsimul is return; end if; - -- Initialize. - Back_End.Finish_Compilation := Sim_Be.Finish_Compilation'Access; - Back_End.Sem_Foreign := null; - Setup_Libraries (False); Libraries.Load_Std_Library; @@ -79,6 +73,7 @@ package body Ghdlsimul is is use Name_Table; use Types; + use Configuration; First_Id : Name_Id; Sec_Id : Name_Id; @@ -117,6 +112,11 @@ package body Ghdlsimul is raise Compilation_Error; end if; end; + + -- Annotate all units. + for I in Design_Units.First .. Design_Units.Last loop + Annotations.Annotate (Design_Units.Table (I)); + end loop; end Compile_Elab; -- Set options. diff --git a/src/ghdldrv/ghdlxml.adb b/src/ghdldrv/ghdlxml.adb index 329af4658..6641202a0 100644 --- a/src/ghdldrv/ghdlxml.adb +++ b/src/ghdldrv/ghdlxml.adb @@ -198,23 +198,26 @@ package body Ghdlxml is Put_Empty_Stag_End; end Disp_Iir_List_Ref; - procedure Disp_Iir_Chain (Id : String; N : Iir) + procedure Disp_Iir_Chain_Elements (Chain : Iir) is El : Iir; begin + El := Chain; + while Is_Valid (El) loop + Disp_Iir ("el", El); + El := Get_Chain (El); + end loop; + end Disp_Iir_Chain_Elements; + + procedure Disp_Iir_Chain (Id : String; N : Iir) is + begin if N = Null_Iir then return; end if; Put_Stag (Id); Put_Stag_End; - - El := N; - while Is_Valid (El) loop - Disp_Iir ("el", El); - El := Get_Chain (El); - end loop; - + Disp_Iir_Chain_Elements (N); Put_Etag (Id); end Disp_Iir_Chain; @@ -513,7 +516,11 @@ package body Ghdlxml is Col := 0; Put_Line ("<?xml version=""1.0"" encoding=""UTF-8"" standalone=""yes""?>"); - Disp_Iir_Chain ("root", Libraries.Get_Libraries_Chain); + Put_Stag ("root"); + Put_Attribute ("version", "0.13"); + Put_Stag_End; + Disp_Iir_Chain_Elements (Libraries.Get_Libraries_Chain); + Put_Etag ("root"); exception when Compilation_Error => Error ("xml dump failed due to compilation error"); |