summaryrefslogtreecommitdiff
path: root/translate/grt
diff options
context:
space:
mode:
Diffstat (limited to 'translate/grt')
-rw-r--r--translate/grt/grt-processes.adb45
-rw-r--r--translate/grt/grt-processes.ads26
-rw-r--r--translate/grt/grt-rtis.ads1
-rw-r--r--translate/grt/grt-signals.ads77
4 files changed, 103 insertions, 46 deletions
diff --git a/translate/grt/grt-processes.adb b/translate/grt/grt-processes.adb
index 50d7601..6b5a393 100644
--- a/translate/grt/grt-processes.adb
+++ b/translate/grt/grt-processes.adb
@@ -123,7 +123,7 @@ package body Grt.Processes is
Stack : Stack_Type;
P : Process_Acc;
begin
- if State /= State_Sensitized then
+ if State /= State_Sensitized and then not One_Stack then
Stack := Stack_Create (Proc, This);
if Stack = Null_Stack then
Internal_Error ("cannot allocate stack: memory exhausted");
@@ -352,7 +352,16 @@ package body Grt.Processes is
Update_Process_First_Timeout (Proc);
end Ghdl_Process_Wait_Set_Timeout;
- function Ghdl_Process_Wait_Suspend return Boolean
+ function Ghdl_Process_Wait_Has_Timeout return Boolean
+ is
+ Proc : constant Process_Acc := Get_Current_Process;
+ begin
+ -- Note: in case of timeout, the timeout is removed when process is
+ -- woken up.
+ return Proc.State = State_Timeout;
+ end Ghdl_Process_Wait_Has_Timeout;
+
+ procedure Ghdl_Process_Wait_Wait
is
Proc : constant Process_Acc := Get_Current_Process;
begin
@@ -364,10 +373,19 @@ package body Grt.Processes is
-- if Cur_Proc.Timeout = Bad_Time then
-- Cur_Proc.Timeout := Std_Time'Last;
-- end if;
- Stack_Switch (Get_Main_Stack, Proc.Stack);
- -- Note: in case of timeout, the timeout is removed when process is
- -- woken up.
- return Proc.State = State_Timeout;
+ end Ghdl_Process_Wait_Wait;
+
+ function Ghdl_Process_Wait_Suspend return Boolean
+ is
+ Proc : constant Process_Acc := Get_Current_Process;
+ begin
+ Ghdl_Process_Wait_Wait;
+ if One_Stack then
+ Internal_Error ("wait_suspend");
+ else
+ Stack_Switch (Get_Main_Stack, Proc.Stack);
+ end if;
+ return Ghdl_Process_Wait_Has_Timeout;
end Ghdl_Process_Wait_Suspend;
procedure Free is new Ada.Unchecked_Deallocation
@@ -446,8 +464,11 @@ package body Grt.Processes is
-- Mark this process as dead, in order to kill it.
-- It cannot be killed now, since this code is still in the process.
Proc.State := State_Dead;
+
-- Suspend this process.
- Stack_Switch (Get_Main_Stack, Proc.Stack);
+ if not One_Stack then
+ Stack_Switch (Get_Main_Stack, Proc.Stack);
+ end if;
end Ghdl_Process_Wait_Exit;
procedure Ghdl_Process_Wait_Timeout (Time : Std_Time)
@@ -465,7 +486,11 @@ package body Grt.Processes is
Proc.State := State_Wait;
Update_Process_First_Timeout (Proc);
-- Suspend this process.
- Stack_Switch (Get_Main_Stack, Proc.Stack);
+ if One_Stack then
+ Internal_Error ("wait_timeout");
+ else
+ Stack_Switch (Get_Main_Stack, Proc.Stack);
+ end if;
-- Clean-up.
Proc.Timeout := Bad_Time;
Remove_Process_From_Timeout_Chain (Proc);
@@ -671,7 +696,7 @@ package body Grt.Processes is
end if;
Proc.Resumed := False;
Set_Current_Process (Proc);
- if Proc.State = State_Sensitized then
+ if Proc.State = State_Sensitized or else One_Stack then
Proc.Subprg.all (Proc.This);
else
Stack_Switch (Proc.Stack, Get_Main_Stack);
@@ -722,7 +747,7 @@ package body Grt.Processes is
Proc.Resumed := False;
Set_Current_Process (Proc);
- if Proc.State = State_Sensitized then
+ if Proc.State = State_Sensitized or else One_Stack then
Proc.Subprg.all (Proc.This);
else
Stack_Switch (Proc.Stack, Get_Main_Stack);
diff --git a/translate/grt/grt-processes.ads b/translate/grt/grt-processes.ads
index 5566233..22326eb 100644
--- a/translate/grt/grt-processes.ads
+++ b/translate/grt/grt-processes.ads
@@ -49,6 +49,10 @@ package Grt.Processes is
-- If true, the simulation should be stopped.
Break_Simulation : Boolean;
+ -- If true, there is one stack for all processes. Non-sensitized
+ -- processes must save their state.
+ One_Stack : Boolean := False;
+
type Process_Type is private;
-- type Process_Acc is access all Process_Type;
@@ -104,20 +108,34 @@ package Grt.Processes is
-- Resume a process.
procedure Resume_Process (Proc : Process_Acc);
- -- Wait without timeout or sensitivity.
+ -- Wait without timeout or sensitivity: wait;
procedure Ghdl_Process_Wait_Exit;
- -- Wait for a timeout.
+ -- Wait for a timeout (without sensitivity): wait for X;
procedure Ghdl_Process_Wait_Timeout (Time : Std_Time);
- -- Add a sensitivity for a wait.
- procedure Ghdl_Process_Wait_Add_Sensitivity (Sig : Ghdl_Signal_Ptr);
+
+ -- Full wait statement:
+ -- 1. Call Ghdl_Process_Wait_Set_Timeout (if there is a timeout)
+ -- 2. Call Ghdl_Process_Wait_Add_Sensitivity (for each signal)
+ -- 3. Call Ghdl_Process_Wait_Suspend, go to 4 if it returns true (timeout)
+ -- Evaluate the condition and go to 4 if true
+ -- Else, restart 3
+ -- 4. Call Ghdl_Process_Wait_Close
+
-- Add a timeout for a wait.
procedure Ghdl_Process_Wait_Set_Timeout (Time : Std_Time);
+ -- Add a sensitivity for a wait.
+ procedure Ghdl_Process_Wait_Add_Sensitivity (Sig : Ghdl_Signal_Ptr);
-- Wait until timeout or sensitivity.
-- Return TRUE in case of timeout.
function Ghdl_Process_Wait_Suspend return Boolean;
-- Finish a wait statement.
procedure Ghdl_Process_Wait_Close;
+ -- For one stack setups, wait_suspend is decomposed into the suspension
+ -- procedure and the function to get resume status.
+ procedure Ghdl_Process_Wait_Wait;
+ function Ghdl_Process_Wait_Has_Timeout return Boolean;
+
-- Verilog.
procedure Ghdl_Process_Delay (Del : Ghdl_U32);
diff --git a/translate/grt/grt-rtis.ads b/translate/grt/grt-rtis.ads
index 414c77a..924b2e0 100644
--- a/translate/grt/grt-rtis.ads
+++ b/translate/grt/grt-rtis.ads
@@ -169,6 +169,7 @@ package Grt.Rtis is
Ghdl_Rti_Signal_Mode_In : constant Ghdl_Rti_U8 := 5;
Ghdl_Rti_Signal_Kind_Mask : constant Ghdl_Rti_U8 := 3 * 16;
+ Ghdl_Rti_Signal_Kind_Offset : constant Ghdl_Rti_U8 := 1 * 16;
Ghdl_Rti_Signal_Kind_No : constant Ghdl_Rti_U8 := 0 * 16;
Ghdl_Rti_Signal_Kind_Register : constant Ghdl_Rti_U8 := 1 * 16;
Ghdl_Rti_Signal_Kind_Bus : constant Ghdl_Rti_U8 := 2 * 16;
diff --git a/translate/grt/grt-signals.ads b/translate/grt/grt-signals.ads
index cc6733d..4d24639 100644
--- a/translate/grt/grt-signals.ads
+++ b/translate/grt/grt-signals.ads
@@ -439,18 +439,36 @@ package Grt.Signals is
procedure Resume_Process_If_Event
(Sig : Ghdl_Signal_Ptr; Proc : Process_Acc);
+ -- Creating a signal:
+ -- 1) call Ghdl_Signal_Name_Rti (CTXT and ADDR are unused) to register
+ -- the RTI for the whole signal (in particular the mode and the
+ -- has_active flag)
+ -- 2) call Ghdl_Create_Signal_XXX for each non-composite element
+
procedure Ghdl_Signal_Name_Rti (Sig : Ghdl_Rti_Access;
Ctxt : Ghdl_Rti_Access;
Addr : System.Address);
+ -- FIXME: document.
procedure Ghdl_Signal_Merge_Rti (Sig : Ghdl_Signal_Ptr;
Rti : Ghdl_Rti_Access);
+ -- Assigning a waveform to a signal:
+ --
+ -- For simple waveform (sig <= val), the short form can be used:
+ -- Ghdl_Signal_Simple_Assign_XX (Sig, Val);
+ -- For all other forms
+ -- SIG <= reject R inertial V1 after T1, V2 after T2, ...:
+ -- Ghdl_Signal_Start_Assign_XX (SIG, R, V1, T1);
+ -- Ghdl_Signal_Next_Assign_XX (SIG, V2, T2);
+ -- ...
+ -- If the delay mechanism is transport, they R = 0,
+ -- if there is no rejection time, the mechanism is internal and R = T1.
+
-- Performs some internal checks on signals (transaction order).
-- Internal_error is called in case of error.
procedure Ghdl_Signal_Internal_Checks;
- -- Subprograms to be called by generated code.
procedure Ghdl_Signal_Simple_Assign_Error (Sign : Ghdl_Signal_Ptr;
File : Ghdl_C_String;
Line : Ghdl_I32);
@@ -475,11 +493,10 @@ package Grt.Signals is
function Ghdl_Signal_Driving (Sig : Ghdl_Signal_Ptr) return Ghdl_B2;
- function Ghdl_Create_Signal_B2
- (Init_Val : Ghdl_B2;
- Resolv_Func : System.Address;
- Resolv_Inst : System.Address)
- return Ghdl_Signal_Ptr;
+ function Ghdl_Create_Signal_B2 (Init_Val : Ghdl_B2;
+ Resolv_Func : System.Address;
+ Resolv_Inst : System.Address)
+ return Ghdl_Signal_Ptr;
procedure Ghdl_Signal_Init_B2 (Sig : Ghdl_Signal_Ptr; Init_Val : Ghdl_B2);
procedure Ghdl_Signal_Associate_B2 (Sig : Ghdl_Signal_Ptr; Val : Ghdl_B2);
procedure Ghdl_Signal_Simple_Assign_B2 (Sign : Ghdl_Signal_Ptr;
@@ -494,11 +511,10 @@ package Grt.Signals is
function Ghdl_Signal_Driving_Value_B2 (Sig : Ghdl_Signal_Ptr)
return Ghdl_B2;
- function Ghdl_Create_Signal_E8
- (Init_Val : Ghdl_E8;
- Resolv_Func : System.Address;
- Resolv_Inst : System.Address)
- return Ghdl_Signal_Ptr;
+ function Ghdl_Create_Signal_E8 (Init_Val : Ghdl_E8;
+ Resolv_Func : System.Address;
+ Resolv_Inst : System.Address)
+ return Ghdl_Signal_Ptr;
procedure Ghdl_Signal_Init_E8 (Sig : Ghdl_Signal_Ptr; Init_Val : Ghdl_E8);
procedure Ghdl_Signal_Associate_E8 (Sig : Ghdl_Signal_Ptr; Val : Ghdl_E8);
procedure Ghdl_Signal_Simple_Assign_E8 (Sign : Ghdl_Signal_Ptr;
@@ -513,11 +529,10 @@ package Grt.Signals is
function Ghdl_Signal_Driving_Value_E8 (Sig : Ghdl_Signal_Ptr)
return Ghdl_E8;
- function Ghdl_Create_Signal_E32
- (Init_Val : Ghdl_E32;
- Resolv_Func : System.Address;
- Resolv_Inst : System.Address)
- return Ghdl_Signal_Ptr;
+ function Ghdl_Create_Signal_E32 (Init_Val : Ghdl_E32;
+ Resolv_Func : System.Address;
+ Resolv_Inst : System.Address)
+ return Ghdl_Signal_Ptr;
procedure Ghdl_Signal_Init_E32 (Sig : Ghdl_Signal_Ptr; Init_Val : Ghdl_E32);
procedure Ghdl_Signal_Associate_E32 (Sig : Ghdl_Signal_Ptr; Val : Ghdl_E32);
procedure Ghdl_Signal_Simple_Assign_E32 (Sign : Ghdl_Signal_Ptr;
@@ -532,11 +547,10 @@ package Grt.Signals is
function Ghdl_Signal_Driving_Value_E32 (Sig : Ghdl_Signal_Ptr)
return Ghdl_E32;
- function Ghdl_Create_Signal_I32
- (Init_Val : Ghdl_I32;
- Resolv_Func : System.Address;
- Resolv_Inst : System.Address)
- return Ghdl_Signal_Ptr;
+ function Ghdl_Create_Signal_I32 (Init_Val : Ghdl_I32;
+ Resolv_Func : System.Address;
+ Resolv_Inst : System.Address)
+ return Ghdl_Signal_Ptr;
procedure Ghdl_Signal_Init_I32 (Sig : Ghdl_Signal_Ptr; Init_Val : Ghdl_I32);
procedure Ghdl_Signal_Associate_I32 (Sig : Ghdl_Signal_Ptr; Val : Ghdl_I32);
procedure Ghdl_Signal_Simple_Assign_I32 (Sign : Ghdl_Signal_Ptr;
@@ -551,11 +565,10 @@ package Grt.Signals is
function Ghdl_Signal_Driving_Value_I32 (Sig : Ghdl_Signal_Ptr)
return Ghdl_I32;
- function Ghdl_Create_Signal_I64
- (Init_Val : Ghdl_I64;
- Resolv_Func : System.Address;
- Resolv_Inst : System.Address)
- return Ghdl_Signal_Ptr;
+ function Ghdl_Create_Signal_I64 (Init_Val : Ghdl_I64;
+ Resolv_Func : System.Address;
+ Resolv_Inst : System.Address)
+ return Ghdl_Signal_Ptr;
procedure Ghdl_Signal_Init_I64 (Sig : Ghdl_Signal_Ptr; Init_Val : Ghdl_I64);
procedure Ghdl_Signal_Associate_I64 (Sig : Ghdl_Signal_Ptr; Val : Ghdl_I64);
procedure Ghdl_Signal_Simple_Assign_I64 (Sign : Ghdl_Signal_Ptr;
@@ -570,11 +583,10 @@ package Grt.Signals is
function Ghdl_Signal_Driving_Value_I64 (Sig : Ghdl_Signal_Ptr)
return Ghdl_I64;
- function Ghdl_Create_Signal_F64
- (Init_Val : Ghdl_F64;
- Resolv_Func : System.Address;
- Resolv_Inst : System.Address)
- return Ghdl_Signal_Ptr;
+ function Ghdl_Create_Signal_F64 (Init_Val : Ghdl_F64;
+ Resolv_Func : System.Address;
+ Resolv_Inst : System.Address)
+ return Ghdl_Signal_Ptr;
procedure Ghdl_Signal_Init_F64 (Sig : Ghdl_Signal_Ptr; Init_Val : Ghdl_F64);
procedure Ghdl_Signal_Associate_F64 (Sig : Ghdl_Signal_Ptr; Val : Ghdl_F64);
procedure Ghdl_Signal_Simple_Assign_F64 (Sign : Ghdl_Signal_Ptr;
@@ -643,7 +655,8 @@ package Grt.Signals is
-- Create a new implicitly defined GUARD signal.
function Ghdl_Signal_Create_Guard (This : System.Address;
Proc : Guard_Func_Acc)
- return Ghdl_Signal_Ptr;
+ return Ghdl_Signal_Ptr;
+
-- Add SIG to the list of referenced signals that appear in the guard
-- expression.
procedure Ghdl_Signal_Guard_Dependence (Sig : Ghdl_Signal_Ptr);
generated by cgit (git 2.34.1) at 2024-12-22 09:39:10 +0000