From 8574c1ae9bf66e3520985e0277a3847b1a210e2e Mon Sep 17 00:00:00 2001 From: Tristan Gingold Date: Sat, 7 May 2016 17:43:03 +0200 Subject: ghdldrv: add functionnal API to compile. --- src/ghdldrv/ghdlcomp.adb | 85 ++++++++++++++++++++++++++++++++++------------- src/ghdldrv/ghdlcomp.ads | 7 ++++ src/ghdldrv/ghdllocal.adb | 11 ++++-- src/ghdldrv/ghdllocal.ads | 5 ++- src/ghdldrv/ghdlsimul.adb | 16 ++++++--- src/ghdldrv/ghdlsimul.ads | 3 ++ 6 files changed, 96 insertions(+), 31 deletions(-) diff --git a/src/ghdldrv/ghdlcomp.adb b/src/ghdldrv/ghdlcomp.adb index 33f1b8bbc..1dfc5111b 100644 --- a/src/ghdldrv/ghdlcomp.adb +++ b/src/ghdldrv/ghdlcomp.adb @@ -172,6 +172,60 @@ package body Ghdlcomp is end if; end Decode_Option; + procedure Compile_Analyze_Init (Load_Work : Boolean := True) is + begin + Hooks.Compile_Init.all (False); + + Flags.Flag_Elaborate_With_Outdated := True; + Flags.Flag_Only_Elab_Warnings := False; + + if Load_Work then + Libraries.Load_Work_Library (False); + -- Also, load all libraries and files, so that every design unit + -- is known. + Load_All_Libraries_And_Files; + else + Libraries.Load_Work_Library (True); + end if; + end Compile_Analyze_Init; + + procedure Compile_Analyze_File (File : String) + is + Res : Iir_Design_File; + Design : Iir; + Next_Design : Iir; + begin + Res := Libraries.Load_File (Name_Table.Get_Identifier (File)); + if Errorout.Nbr_Errors > 0 then + raise Compilation_Error; + end if; + + -- Put units into library. + Design := Get_First_Design_Unit (Res); + while not Is_Null (Design) loop + Next_Design := Get_Chain (Design); + Set_Chain (Design, Null_Iir); + Libraries.Add_Design_Unit_Into_Library (Design); + Design := Next_Design; + end loop; + end Compile_Analyze_File; + + procedure Compile_Elaborate (Unit_Name : String_Access) + is + Run_Arg : Natural; + begin + Hooks.Compile_Elab.all ("-c", (1 => Unit_Name), Run_Arg); + pragma Unreferenced (Run_Arg); + end Compile_Elaborate; + + procedure Compile_Run + is + No_Arg : constant Argument_List := (1 .. 0 => null); + begin + Hooks.Set_Run_Options (No_Arg); + Hooks.Run.all; + end Compile_Run; + procedure Perform_Action (Cmd : in out Command_Compile; Args : Argument_List) is @@ -188,44 +242,29 @@ package body Ghdlcomp is if Args'Length > 1 and then (Args (Args'First).all = "-r" or else Args (Args'First).all = "-e") then - -- If there is no files, then load the work library. - Libraries.Load_Work_Library (False); - -- Also, load all libraries and files, so that every design unit - -- is known. - Load_All_Libraries_And_Files; + -- If there is no files, then load the work library, all the + -- libraries referenced and all the files. + Compile_Analyze_Init (True); Elab_Arg := Args'First + 1; else -- If there is at least one file, do not load the work library. - Libraries.Load_Work_Library (True); + Compile_Analyze_Init (False); Elab_Arg := Natural'Last; for I in Args'Range loop declare Arg : constant String := Args (I).all; - Res : Iir_Design_File; - Design : Iir; - Next_Design : Iir; begin if Arg = "-r" or else Arg = "-e" then Elab_Arg := I + 1; exit; else - Res := Libraries.Load_File - (Name_Table.Get_Identifier (Arg)); - if Errorout.Nbr_Errors > 0 then - raise Compilation_Error; - end if; - - -- Put units into library. - Design := Get_First_Design_Unit (Res); - while not Is_Null (Design) loop - Next_Design := Get_Chain (Design); - Set_Chain (Design, Null_Iir); - Libraries.Add_Design_Unit_Into_Library (Design); - Design := Next_Design; - end loop; + Compile_Analyze_File (Arg); end if; end; end loop; + + -- Save the library (and do not elaborate) if there is neither + -- '-e' nor '-r'. if Elab_Arg = Natural'Last then Libraries.Save_Work_Library; return; diff --git a/src/ghdldrv/ghdlcomp.ads b/src/ghdldrv/ghdlcomp.ads index f803ca4fa..383d9b92d 100644 --- a/src/ghdldrv/ghdlcomp.ads +++ b/src/ghdldrv/ghdlcomp.ads @@ -64,4 +64,11 @@ package Ghdlcomp is -- Register commands. procedure Register_Commands; + + -- Functionnal interface. + -- Must be first initialized by Compile_Init + procedure Compile_Analyze_Init (Load_Work : Boolean := True); + procedure Compile_Analyze_File (File : String); + procedure Compile_Elaborate (Unit_Name : String_Access); + procedure Compile_Run; end Ghdlcomp; diff --git a/src/ghdldrv/ghdllocal.adb b/src/ghdldrv/ghdllocal.adb index dfc206649..a28c44bee 100644 --- a/src/ghdldrv/ghdllocal.adb +++ b/src/ghdldrv/ghdllocal.adb @@ -108,14 +108,19 @@ package body Ghdllocal is end if; end Finish_Compilation; - procedure Init (Cmd : in out Command_Lib) - is - pragma Unreferenced (Cmd); + procedure Compile_Init is begin Options.Initialize; Flag_Ieee := Lib_Standard; Back_End.Finish_Compilation := Finish_Compilation'Access; Flag_Verbose := False; + end Compile_Init; + + procedure Init (Cmd : in out Command_Lib) + is + pragma Unreferenced (Cmd); + begin + Compile_Init; end Init; procedure Decode_Option (Cmd : in out Command_Lib; diff --git a/src/ghdldrv/ghdllocal.ads b/src/ghdldrv/ghdllocal.ads index b744950a6..43f2de8cb 100644 --- a/src/ghdldrv/ghdllocal.ads +++ b/src/ghdldrv/ghdllocal.ads @@ -20,9 +20,12 @@ with Ghdlmain; use Ghdlmain; with Iirs; use Iirs; package Ghdllocal is + -- Init procedure for the functionnal interface. + procedure Compile_Init; + type Command_Lib is abstract new Command_Type with null record; - -- Setup GHDL. + -- Setup GHDL. Same as Compile_Init. procedure Init (Cmd : in out Command_Lib); -- Handle: diff --git a/src/ghdldrv/ghdlsimul.adb b/src/ghdldrv/ghdlsimul.adb index e17d83c2f..ddf70bbb3 100644 --- a/src/ghdldrv/ghdlsimul.adb +++ b/src/ghdldrv/ghdlsimul.adb @@ -42,8 +42,6 @@ with Execution; with Ghdlcomp; -with Grt.Vpi; -pragma Unreferenced (Grt.Vpi); with Grt.Types; with Grt.Options; with Grt.Errors; @@ -207,8 +205,7 @@ package body Ghdlsimul is Put_Line (" --debug Run with debugger"); end Disp_Long_Help; - procedure Register_Commands - is + procedure Set_Hooks is begin Ghdlcomp.Hooks := (Compile_Init'Access, Compile_Elab'Access, @@ -216,6 +213,17 @@ package body Ghdlsimul is Run'Access, Decode_Option'Access, Disp_Long_Help'Access); + end Set_Hooks; + + procedure Register_Commands is + begin + Set_Hooks; Ghdlcomp.Register_Commands; end Register_Commands; + + procedure Compile_Init is + begin + Ghdllocal.Compile_Init; + Set_Hooks; + end Compile_Init; end Ghdlsimul; diff --git a/src/ghdldrv/ghdlsimul.ads b/src/ghdldrv/ghdlsimul.ads index 264cbf8c6..4345d1349 100644 --- a/src/ghdldrv/ghdlsimul.ads +++ b/src/ghdldrv/ghdlsimul.ads @@ -17,4 +17,7 @@ -- 02111-1307, USA. package Ghdlsimul is procedure Register_Commands; + + -- Functional interface. + procedure Compile_Init; end Ghdlsimul; -- cgit v1.2.3