ghdldrv: add functionnal API to compile.

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;