diff options
Diffstat (limited to 'src/grt')
-rw-r--r-- | src/grt/ghdl_main.adb | 12 | ||||
-rw-r--r-- | src/grt/grt-main.adb | 69 | ||||
-rw-r--r-- | src/grt/grt-main.ads | 21 | ||||
-rw-r--r-- | src/grt/grt-processes.adb | 67 | ||||
-rw-r--r-- | src/grt/grt-processes.ads | 16 | ||||
-rw-r--r-- | src/grt/grt-rtis.ads | 1 | ||||
-rw-r--r-- | src/grt/grt-rtis_utils.adb | 4 | ||||
-rw-r--r-- | src/grt/grt-types.ads | 3 | ||||
-rw-r--r-- | src/grt/grt-unithread.adb | 1 | ||||
-rw-r--r-- | src/grt/grt-unithread.ads | 1 |
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 |