grt: add code to support systemc co-simulation.

10 files changed, 147 insertions, 48 deletions

diff --git a/src/grt/ghdl_main.adb b/src/grt/ghdl_main.adb
index 86f11aa5b..4311e603a 100644
--- a/src/grt/ghdl_main.adb
+++ b/src/grt/ghdl_main.adb
@@ -44,18 +44,10 @@ is
    function To_Argv_Type is new Ada.Unchecked_Conversion
      (Source => System.Address, Target => Grt.Options.Argv_Type);
 
-   Default_Progname : constant String := "ghdl_design" & NUL;
+   My_Argv : Grt.Options.Argv_Type := To_Argv_Type (Argv);
 begin
-   --  Set program name.
-   if Argc > 0 then
-      Grt.Options.Progname := To_Argv_Type (Argv)(0);
-   else
-      Grt.Options.Progname := To_Ghdl_C_String (Default_Progname'Address);
-   end if;
-   Grt.Options.Argc := Argc;
-   Grt.Options.Argv := To_Argv_Type (Argv);
-
    Grt_Init;
+   Grt.Main.Run_Options (My_Argv (0), Argc, My_Argv);
    Grt.Main.Run;
    return Grt.Errors.Exit_Status;
 end Ghdl_Main;
diff --git a/src/grt/grt-main.adb b/src/grt/grt-main.adb
index 8a0f307b9..2dda446cf 100644
--- a/src/grt/grt-main.adb
+++ b/src/grt/grt-main.adb
@@ -22,7 +22,6 @@
 --  covered by the GNU General Public License. This exception does not
 --  however invalidate any other reasons why the executable file might be
 --  covered by the GNU Public License.
-with Grt.Types; use Grt.Types;
 with Grt.Stdio;
 with Grt.Errors; use Grt.Errors;
 with Grt.Processes;
@@ -30,8 +29,6 @@ with Grt.Signals;
 with Grt.Options; use Grt.Options;
 with Grt.Stats;
 with Grt.Hooks;
-with Grt.Disp_Signals;
-with Grt.Disp;
 with Grt.Modules;
 with Grt.Change_Generics;
 
@@ -103,7 +100,26 @@ package body Grt.Main is
       end if;
    end Check_Flag_String;
 
-   procedure Run_Elab (Stop : out Boolean) is
+   Default_Progname : constant String := "ghdl" & NUL;
+
+   --  Initialization: decode options, but no elaboration.
+   --  Return False in case of error.
+   procedure Run_Options (Progname : Ghdl_C_String;
+                          Argc : Integer;
+                          Argv : Grt.Options.Argv_Type) is
+   begin
+      if Progname = null then
+         Grt.Options.Progname := To_Ghdl_C_String (Default_Progname'Address);
+      else
+         Grt.Options.Progname := Progname;
+      end if;
+      Grt.Options.Argc := Argc;
+      Grt.Options.Argv := Argv;
+   end Run_Options;
+
+   function Run_Init return C_Boolean
+   is
+      Stop : Boolean;
    begin
       --  Set stream for error messages
       Grt.Errors.Set_Error_Stream (Grt.Stdio.stdout);
@@ -117,7 +133,7 @@ package body Grt.Main is
 
       --  Early stop (for options such as --help).
       if Stop then
-         return;
+         return False;
       end if;
 
       --  Check coherency between GRT and GHDL generated code.
@@ -130,6 +146,11 @@ package body Grt.Main is
 
       Grt.Signals.Init;
 
+      return True;
+   end Run_Init;
+
+   function Run_Elab return C_Boolean is
+   begin
       if Flag_Stats then
          Stats.Start_Elaboration;
       end if;
@@ -137,35 +158,11 @@ package body Grt.Main is
       --  Elaboration.  Run through longjump to catch errors.
       if Run_Through_Longjump (Ghdl_Elaborate_Wrapper'Access) < 0 then
          Grt.Errors.Error ("error during elaboration");
-         Stop := True;
-         return;
-      end if;
-
-      if Flag_Stats then
-         Stats.Start_Order;
-      end if;
-
-      Grt.Hooks.Call_Start_Hooks;
-
-      if not Flag_No_Run then
-         Grt.Signals.Order_All_Signals;
-
-         if Grt.Options.Disp_Signals_Map then
-            Grt.Disp_Signals.Disp_Signals_Map;
-         end if;
-         if Grt.Options.Disp_Signals_Table then
-            Grt.Disp_Signals.Disp_Signals_Table;
-         end if;
-         if Disp_Signals_Order then
-            Grt.Disp.Disp_Signals_Order;
-         end if;
-         if Disp_Sensitivity then
-            Grt.Disp_Signals.Disp_All_Sensitivity;
-         end if;
+         return False;
       end if;
 
       --  Can continue.
-      Stop := False;
+      return True;
    end Run_Elab;
 
    function Run_Simul return Integer is
@@ -199,11 +196,15 @@ package body Grt.Main is
 
    procedure Run
    is
-      Stop : Boolean;
+      Ok : C_Boolean;
       Status : Integer;
    begin
-      Run_Elab (Stop);
-      if Stop then
+      Ok := Run_Init;
+      if not Ok then
+         return;
+      end if;
+      Ok := Run_Elab;
+      if not Ok then
          return;
       end if;
 
diff --git a/src/grt/grt-main.ads b/src/grt/grt-main.ads
index e4a6bff9c..af14add20 100644
--- a/src/grt/grt-main.ads
+++ b/src/grt/grt-main.ads
@@ -23,14 +23,29 @@
 --  however invalidate any other reasons why the executable file might be
 --  covered by the GNU Public License.
 
+with Grt.Types; use Grt.Types;
+with Grt.Options;
+
 package Grt.Main is
-   --  Elaborate and simulate the design.
+   --  Set options.
+   procedure Run_Options (Progname : Ghdl_C_String;
+                          Argc : Integer;
+                          Argv : Grt.Options.Argv_Type);
+   pragma Export (C, Run_Options, "grt_main_options");
+
+   --  Do everything: initialize, elaborate and simulate the design.
    procedure Run;
 
    --  What Run does.
 
-   --  Elaborate the design.
-   procedure Run_Elab (Stop : out Boolean);
+   --  Initialization: decode options, but no elaboration.
+   --  Return False in case of error.
+   function Run_Init return C_Boolean;
+   pragma Export (C, Run_Init, "grt_main_init");
+
+   --  Elaborate the design.  Return False in case of error.
+   function Run_Elab return C_Boolean;
+   pragma Export (C, Run_Elab, "grt_main_elab");
 
    --  Do the whole simulation.
    function Run_Simul return Integer;
diff --git a/src/grt/grt-processes.adb b/src/grt/grt-processes.adb
index a2060ad02..f1de1f03c 100644
--- a/src/grt/grt-processes.adb
+++ b/src/grt/grt-processes.adb
@@ -227,6 +227,7 @@ package body Grt.Processes is
                              Subprg => Proc,
                              This => This);
       Process_Table.Append (P);
+      Nbr_Non_Postponed_Processes := Nbr_Non_Postponed_Processes + 1;
       --  Used to create drivers.
       Set_Current_Process (P);
    end Verilog_Process_Register;
@@ -245,6 +246,13 @@ package body Grt.Processes is
       Verilog_Process_Register (Instance, Proc, Null_Context);
    end Ghdl_Always_Register;
 
+   function Ghdl_Register_Foreign_Process
+     (Instance : Instance_Acc; Proc : Proc_Acc) return Process_Acc is
+   begin
+      Verilog_Process_Register (Instance, Proc, Null_Context);
+      return Get_Current_Process;
+   end Ghdl_Register_Foreign_Process;
+
    procedure Ghdl_Process_Add_Sensitivity (Sig : Ghdl_Signal_Ptr)
    is
    begin
@@ -1082,6 +1090,27 @@ package body Grt.Processes is
    is
       use Options;
    begin
+      if Flag_Stats then
+         Stats.Start_Order;
+      end if;
+
+      Grt.Hooks.Call_Start_Hooks;
+
+      Grt.Signals.Order_All_Signals;
+
+      if Grt.Options.Disp_Signals_Map then
+         Grt.Disp_Signals.Disp_Signals_Map;
+      end if;
+      if Grt.Options.Disp_Signals_Table then
+         Grt.Disp_Signals.Disp_Signals_Table;
+      end if;
+      if Disp_Signals_Order then
+         Grt.Disp.Disp_Signals_Order;
+      end if;
+      if Disp_Sensitivity then
+         Grt.Disp_Signals.Disp_All_Sensitivity;
+      end if;
+
       if Nbr_Threads /= 1 then
          Threads.Init;
       end if;
@@ -1134,6 +1163,44 @@ package body Grt.Processes is
       end if;
    end Has_Simulation_Timeout;
 
+   function Simulation_Step return Integer
+   is
+      use Options;
+      Status : Integer;
+   begin
+      Status := Simulation_Cycle;
+
+      --  Simulation has been stopped/finished by vpi.
+      if Status = Run_Stop then
+         return 2;
+      end if;
+
+      if Trace_Signals then
+         Grt.Disp_Signals.Disp_All_Signals;
+      end if;
+
+      --  Simulation is finished.
+      if Status = Run_Finished then
+         return 3;
+      end if;
+
+      --  Simulation is stopped by user timeout.
+      if Has_Simulation_Timeout then
+         return 4;
+      end if;
+
+      if Current_Delta = 0 then
+         Grt.Hooks.Call_Cycle_Hooks;
+         return 1;
+      else
+         if Current_Delta >= Stop_Delta then
+            return 5;
+         else
+            return 0;
+         end if;
+      end if;
+   end Simulation_Step;
+
    function Simulation_Main_Loop return Integer
    is
       use Options;
diff --git a/src/grt/grt-processes.ads b/src/grt/grt-processes.ads
index 2cd091524..7a5577c11 100644
--- a/src/grt/grt-processes.ads
+++ b/src/grt/grt-processes.ads
@@ -45,9 +45,20 @@ package Grt.Processes is
 
    --  Broken down version of Simulation.
    function Simulation_Init return Integer;
+   pragma Export (C, Simulation_Init, "__ghdl_simulation_init");
    function Simulation_Cycle return Integer;
    procedure Simulation_Finish;
 
+   function Simulation_Step return Integer;
+   pragma Export (C, Simulation_Step, "__ghdl_simulation_step");
+   --  Return value:
+   --  0: delta cycle
+   --  1: non-delta cycle
+   --  2: stop
+   --  3: finished
+   --  4: stop-time reached
+   --  5: stop-delta reached
+
    --  True if simulation has reached a user timeout (--stop-time or
    --  --stop-delta).  Emit an info message as a side effect.
    function Has_Simulation_Timeout return Boolean;
@@ -124,6 +135,9 @@ package Grt.Processes is
    procedure Ghdl_Always_Register (Instance : Instance_Acc;
                                    Proc : Proc_Acc);
 
+   function Ghdl_Register_Foreign_Process
+     (Instance : Instance_Acc; Proc : Proc_Acc) return Process_Acc;
+
    --  Add a simple signal in the sensitivity of the last registered
    --  (sensitized) process.
    procedure Ghdl_Process_Add_Sensitivity (Sig : Ghdl_Signal_Ptr);
@@ -251,6 +265,8 @@ private
 
    pragma Export (C, Ghdl_Always_Register, "__ghdl_always_register");
    pragma Export (C, Ghdl_Initial_Register, "__ghdl_initial_register");
+   pragma Export (C, Ghdl_Register_Foreign_Process,
+                  "__ghdl_register_foreign_process");
 
    pragma Export (C, Ghdl_Process_Add_Sensitivity,
                   "__ghdl_process_add_sensitivity");
diff --git a/src/grt/grt-rtis.ads b/src/grt/grt-rtis.ads
index d4664492f..eebe5c200 100644
--- a/src/grt/grt-rtis.ads
+++ b/src/grt/grt-rtis.ads
@@ -445,6 +445,7 @@ package Grt.Rtis is
 
    --  Address of the top instance.
    Ghdl_Rti_Top_Instance : Address;
+   pragma Export (C, Ghdl_Rti_Top_Instance, "__ghdl_rti_top_instance");
 
    --  Instances have a pointer to their RTI at offset 0.
    type Ghdl_Rti_Acc_Acc is access Ghdl_Rti_Access;
diff --git a/src/grt/grt-rtis_utils.adb b/src/grt/grt-rtis_utils.adb
index 7f78de01c..be7696580 100644
--- a/src/grt/grt-rtis_utils.adb
+++ b/src/grt/grt-rtis_utils.adb
@@ -641,6 +641,10 @@ package body Grt.Rtis_Utils is
       Ctxt := Last_Ctxt;
       loop
          Blk := To_Ghdl_Rtin_Block_Acc (Ctxt.Block);
+         if Blk = null then
+            Prepend (Rstr, "???");
+            return;
+         end if;
          case Ctxt.Block.Kind is
             when Ghdl_Rtik_Entity =>
                declare
diff --git a/src/grt/grt-types.ads b/src/grt/grt-types.ads
index fdabf4368..910c03589 100644
--- a/src/grt/grt-types.ads
+++ b/src/grt/grt-types.ads
@@ -167,6 +167,9 @@ package Grt.Types is
    function To_Ghdl_Location_Ptr is new Ada.Unchecked_Conversion
      (Source => Address, Target => Ghdl_Location_Ptr);
 
+   type C_Boolean is new Boolean;
+   pragma Convention (C, C_Boolean);
+
    --  Signal index.
    type Sig_Table_Index is new Integer;
 
diff --git a/src/grt/grt-unithread.adb b/src/grt/grt-unithread.adb
index 7e135339b..8b55c683c 100644
--- a/src/grt/grt-unithread.adb
+++ b/src/grt/grt-unithread.adb
@@ -69,7 +69,6 @@ package body Grt.Unithread is
       return Current_Process;
    end Grt_Get_Current_Process;
 
-
    procedure Set_Current_Process (Proc : Process_Acc) is
    begin
       Current_Process := Proc;
diff --git a/src/grt/grt-unithread.ads b/src/grt/grt-unithread.ads
index 6bfacab21..ce8678245 100644
--- a/src/grt/grt-unithread.ads
+++ b/src/grt/grt-unithread.ads
@@ -43,6 +43,7 @@ package Grt.Unithread is
 
    --  Set and get the current process being executed by the thread.
    procedure Set_Current_Process (Proc : Process_Acc);
+   pragma Export (C, Set_Current_Process, "__ghdl_set_current_process");
    function Get_Current_Process return Process_Acc;
 
    --  The stack2 for all sensitized process.  Since they cannot have