diff options
Diffstat (limited to 'src/simul/simul-vhdl_simul.adb')
| -rw-r--r-- | src/simul/simul-vhdl_simul.adb | 287 |
1 files changed, 243 insertions, 44 deletions
diff --git a/src/simul/simul-vhdl_simul.adb b/src/simul/simul-vhdl_simul.adb index 0ebb719f0..354ca062f 100644 --- a/src/simul/simul-vhdl_simul.adb +++ b/src/simul/simul-vhdl_simul.adb @@ -69,6 +69,9 @@ package body Simul.Vhdl_Simul is procedure Process_Executer (Self : Grt.Processes.Instance_Acc); pragma Convention (C, Process_Executer); + procedure Update_Signal_Individual_Assocs_Values + (Inst : Synth_Instance_Acc); + type Ghdl_Signal_Ptr_Ptr is access all Ghdl_Signal_Ptr; function To_Ghdl_Signal_Ptr_Ptr is new Ada.Unchecked_Conversion (Memory_Ptr, Ghdl_Signal_Ptr_Ptr); @@ -110,20 +113,32 @@ package body Simul.Vhdl_Simul is function Hook_Signal_Expr (Val : Valtyp) return Valtyp is begin - if Val.Val.Kind = Value_Alias then - declare - E : Signal_Entry renames Signals_Table.Table (Val.Val.A_Obj.S); - begin - return Create_Value_Memtyp - ((Val.Typ, E.Val + Val.Val.A_Off.Mem_Off)); - end; - else - declare - E : Signal_Entry renames Signals_Table.Table (Val.Val.S); - begin - return Create_Value_Memtyp ((E.Typ, E.Val)); - end; - end if; + case Val.Val.Kind is + when Value_Alias => + declare + E : Signal_Entry renames Signals_Table.Table (Val.Val.A_Obj.S); + begin + return Create_Value_Memtyp + ((Val.Typ, E.Val + Val.Val.A_Off.Mem_Off)); + end; + when Value_Signal => + declare + E : Signal_Entry renames Signals_Table.Table (Val.Val.S); + begin + return Create_Value_Memtyp ((E.Typ, E.Val)); + end; + when Value_Sig_Val => + return Create_Value_Memtyp ((Val.Typ, Val.Val.I_Vals)); + when Value_Net + | Value_Wire + | Value_Memory + | Value_File + | Value_Quantity + | Value_Terminal + | Value_Dyn_Alias + | Value_Const => + raise Internal_Error; + end case; end Hook_Signal_Expr; function Hook_Quantity_Expr (Val : Valtyp) return Valtyp is @@ -331,6 +346,29 @@ package body Simul.Vhdl_Simul is end loop; end Create_Process_Drivers; + function Get_Sig_Mem (Val : Value_Acc; Idx : Uns32) return Memory_Ptr + is + Base : Memory_Ptr; + begin + case Val.Kind is + when Value_Signal => + Base := Signals_Table.Table (Val.S).Sig; + when Value_Sig_Val => + Base := Val.I_Sigs; + when Value_Net + | Value_Wire + | Value_Memory + | Value_File + | Value_Quantity + | Value_Terminal + | Value_Const + | Value_Dyn_Alias + | Value_Alias => + raise Internal_Error; + end case; + return Sig_Index (Base, Idx); + end Get_Sig_Mem; + type Read_Signal_Flag_Enum is (Read_Signal_Event, Read_Signal_Active, @@ -407,10 +445,10 @@ package body Simul.Vhdl_Simul is pragma Assert (Pfx.Obj.Val /= null and then Pfx.Obj.Val.Kind = Value_Signal); E := Read_Signal_Flag - ((Pfx.Targ_Type, - Sig_Index (Signals_Table.Table (Pfx.Obj.Val.S).Sig, - Pfx.Off.Net_Off)), - Kind); + ((Pfx.Targ_Type, Get_Sig_Mem (Pfx.Obj.Val, Pfx.Off.Net_Off)), Kind); + if Kind = Read_Signal_Not_Driving then + E := not E; + end if; Res := Create_Value_Memory (Boolean_Type, Expr_Pool'Access); Write_U8 (Res.Val.Mem, Boolean'Pos (E)); return Res; @@ -428,6 +466,12 @@ package body Simul.Vhdl_Simul is return Exec_Signal_Flag_Attribute (Inst, Expr, Read_Signal_Active); end Exec_Active_Attribute; + function Exec_Driving_Attribute (Inst : Synth_Instance_Acc; + Expr : Node) return Valtyp is + begin + return Exec_Signal_Flag_Attribute (Inst, Expr, Read_Signal_Not_Driving); + end Exec_Driving_Attribute; + function Exec_Dot_Attribute (Inst : Synth_Instance_Acc; Expr : Node) return Valtyp is @@ -696,9 +740,8 @@ package body Simul.Vhdl_Simul is while Is_Valid (It) loop El := Get_Element (It); Info := Synth_Target (Inst, El); - Sig := Signals_Table.Table (Info.Obj.Val.S).Sig; - Add_Wait_Sensitivity - (Info.Targ_Type, Sig_Index (Sig, Info.Off.Net_Off)); + Sig := Get_Sig_Mem (Info.Obj.Val, Info.Off.Net_Off); + Add_Wait_Sensitivity (Info.Targ_Type, Sig); Next (It); end loop; end; @@ -715,6 +758,21 @@ package body Simul.Vhdl_Simul is function Resume_Wait_Statement (Inst : Synth_Instance_Acc; Stmt : Node) return Boolean is begin + -- For all procedures in the activation chain, update individual + -- signal associations. + declare + Cinst : Synth_Instance_Acc; + begin + Cinst := Inst; + loop + if Get_Indiv_Signal_Assoc_Flag (Cinst) then + Update_Signal_Individual_Assocs_Values (Cinst); + end if; + exit when not Get_Indiv_Signal_Assoc_Parent_Flag (Cinst); + Cinst := Get_Instance_Parent (Cinst); + end loop; + end; + -- LRM93 8.1 -- The suspended process will resume, at the latest, immediately -- after the timeout interval has expired. @@ -895,6 +953,11 @@ package body Simul.Vhdl_Simul is Aft : Node; Rej : Node; begin + -- Nothing to assign. + if Get_Kind (Waveform) = Iir_Kind_Unaffected_Waveform then + return; + end if; + Rej := Get_Reject_Time_Expression (Stmt); if Rej /= Null_Node then raise Internal_Error; @@ -965,13 +1028,35 @@ package body Simul.Vhdl_Simul is end case; end Disconnect_Signal; - procedure Disconnect_Signal_Target (Target : Target_Info) - is - E : Signal_Entry renames Signals_Table.Table (Target.Obj.Val.S); - Sig : Memtyp; + procedure Disconnect_Signal_Target (Inst : Synth_Instance_Acc; + Target : Target_Info) is begin - Sig := (Target.Targ_Type, Sig_Index (E.Sig, Target.Off.Net_Off)); - Disconnect_Signal (Sig); + case Target.Kind is + when Target_Simple => + declare + Sig : Memtyp; + begin + Sig := (Target.Targ_Type, + Get_Sig_Mem (Target.Obj.Val, Target.Off.Net_Off)); + Disconnect_Signal (Sig); + end; + when Target_Aggregate => + declare + Choice : Node; + Assoc_Expr : Node; + Sub_Targ : Target_Info; + begin + Choice := Get_Association_Choices_Chain (Target.Aggr); + while Choice /= Null_Node loop + Assoc_Expr := Get_Associated_Expr (Choice); + Sub_Targ := Synth_Target (Inst, Assoc_Expr); + Disconnect_Signal_Target (Inst, Sub_Targ); + Choice := Get_Chain (Choice); + end loop; + end; + when Target_Memory => + raise Internal_Error; + end case; end Disconnect_Signal_Target; function Execute_Maybe_Guarded_Assignment (Inst : Synth_Instance_Acc; @@ -984,7 +1069,7 @@ package body Simul.Vhdl_Simul is if Guard /= Null_Node and then not Execute_Condition (Inst, Guard) then - Disconnect_Signal_Target (Targ); + Disconnect_Signal_Target (Inst, Targ); return True; else return False; @@ -2047,10 +2132,10 @@ package body Simul.Vhdl_Simul is -- For conversion functions. Read_Signal_Driving_Value, - Read_Signal_Effective_Value --, + Read_Signal_Effective_Value, -- 'Driving_Value --- Read_Signal_Driver_Value + Read_Signal_Driver_Value ); procedure Exec_Read_Signal (Sig: Memory_Ptr; @@ -2069,6 +2154,8 @@ package body Simul.Vhdl_Simul is Write_Ghdl_Value (Val, S.Value_Ptr.all); when Read_Signal_Last_Value => Write_Ghdl_Value (Val, S.Last_Value); + when Read_Signal_Driver_Value => + Write_Ghdl_Value (Val, Ghdl_Signal_Driving_Value (S)); end case; when Type_Vector | Type_Array => @@ -2098,24 +2185,38 @@ package body Simul.Vhdl_Simul is end case; end Exec_Read_Signal; - function Exec_Last_Value_Attribute (Inst : Synth_Instance_Acc; - Expr : Node) return Valtyp + function Exec_Signal_Value_Attribute (Inst : Synth_Instance_Acc; + Attr : Node; + Kind : Read_Signal_Enum) return Valtyp is Pfx : Target_Info; Res : Valtyp; S : Memory_Ptr; begin - Pfx := Synth_Target (Inst, Get_Prefix (Expr)); + Pfx := Synth_Target (Inst, Get_Prefix (Attr)); Res := Create_Value_Memory (Pfx.Targ_Type, Expr_Pool'Access); S := Sig_Index (Signals_Table.Table (Pfx.Obj.Val.S).Sig, Pfx.Off.Net_Off); - Exec_Read_Signal (S, Get_Memtyp (Res), Read_Signal_Last_Value); + Exec_Read_Signal (S, Get_Memtyp (Res), Kind); return Res; + end Exec_Signal_Value_Attribute; + + function Exec_Last_Value_Attribute (Inst : Synth_Instance_Acc; + Expr : Node) return Valtyp is + begin + return Exec_Signal_Value_Attribute (Inst, Expr, Read_Signal_Last_Value); end Exec_Last_Value_Attribute; + function Exec_Driving_Value_Attribute (Inst : Synth_Instance_Acc; + Expr : Node) return Valtyp is + begin + return Exec_Signal_Value_Attribute + (Inst, Expr, Read_Signal_Driver_Value); + end Exec_Driving_Value_Attribute; + type Read_Signal_Last_Enum is ( Read_Signal_Last_Event, @@ -2193,6 +2294,11 @@ package body Simul.Vhdl_Simul is Pfx.Off.Net_Off); T := Exec_Read_Signal_Last (S, Get_Memtyp (Res), Attr); + if T < 0 then + T := Std_Time'Last; + else + T := Current_Time - T; + end if; Write_I64 (Res.Val.Mem, Ghdl_I64 (T)); return Res; end Exec_Signal_Last_Attribute; @@ -2668,14 +2774,15 @@ package body Simul.Vhdl_Simul is end case; end Register_Prefix; - function Alloc_Signal_Memory (Vtype : Type_Acc) return Memory_Ptr + function Alloc_Signal_Memory + (Vtype : Type_Acc; Pool : Areapools.Areapool_Acc) return Memory_Ptr is function To_Memory_Ptr is new Ada.Unchecked_Conversion (System.Address, Memory_Ptr); M : System.Address; begin - Areapools.Allocate (Global_Pool, - M, Sig_Size * Size_Type (Vtype.W), Sig_Size); + Areapools.Allocate + (Pool.all, M, Sig_Size * Size_Type (Vtype.W), Sig_Size); return To_Memory_Ptr (M); end Alloc_Signal_Memory; @@ -2694,7 +2801,7 @@ package body Simul.Vhdl_Simul is E : Signal_Entry renames Signals_Table.Table (Idx); S : Ghdl_Signal_Ptr; begin - E.Sig := Alloc_Signal_Memory (E.Typ); + E.Sig := Alloc_Signal_Memory (E.Typ, Global_Pool'Access); case E.Kind is when Mode_Guard => Create_Guard_Signal (Idx); @@ -2709,9 +2816,10 @@ package body Simul.Vhdl_Simul is Write_Sig (E.Sig, S); Register_Prefix (E.Pfx.Typ, To_Memory_Ptr (E.Pfx)); when Mode_Transaction => - -- Create_Implicit_Signal - -- (E.Sig, E.Val, E.Time, E.Prefix, E.Kind); - raise Internal_Error; + S := Grt.Signals.Ghdl_Create_Transaction_Signal + (To_Ghdl_Value_Ptr (To_Address (E.Val))); + Write_Sig (E.Sig, S); + Register_Prefix (E.Pfx.Typ, To_Memory_Ptr (E.Pfx)); when Mode_Delayed => Create_Delayed_Signal (E.Sig, E.Val, To_Memory_Ptr (E.Pfx), E.Typ, E.Time); @@ -3089,7 +3197,7 @@ package body Simul.Vhdl_Simul is if Out_Conv /= Null_Node then -- From formal to actual. Ctyp := C.Actual.Typ; - Csig := Alloc_Signal_Memory (Ctyp); + Csig := Alloc_Signal_Memory (Ctyp, Global_Pool'Access); Cval := Alloc_Memory (Ctyp, Global_Pool'Access); Create_Shadow_Signal (Csig, Cval, Ctyp); Form2 := (Ctyp, Csig); @@ -3124,7 +3232,7 @@ package body Simul.Vhdl_Simul is if In_Conv /= Null_Node then Ctyp := C.Formal.Typ; - Csig := Alloc_Signal_Memory (Ctyp); + Csig := Alloc_Signal_Memory (Ctyp, Global_Pool'Access); Cval := Alloc_Memory (Ctyp, Global_Pool'Access); Create_Shadow_Signal (Csig, Cval, Ctyp); Act2 := (Ctyp, Csig); @@ -3223,8 +3331,93 @@ package body Simul.Vhdl_Simul is end loop; end Create_Connects; - procedure Create_Terminals + procedure Update_Sig_Val (Typ : Type_Acc; + Sigs : Memory_Ptr; + Vals : Memory_Ptr) is + Sig : Ghdl_Signal_Ptr; + begin + case Typ.Kind is + when Type_Logic + | Type_Bit + | Type_Discrete + | Type_Float => + Sig := Read_Sig (Sigs); + Write_Ghdl_Value ((Typ, Vals), Sig.Value_Ptr.all); + when Type_Vector + | Type_Array => + declare + Len : constant Uns32 := Typ.Abound.Len; + El : constant Type_Acc := Typ.Arr_El; + begin + for I in 1 .. Len loop + Update_Sig_Val (El, + Sig_Index (Sigs, (Len - I) * El.W), + Vals + Size_Type (I - 1) * El.Sz); + end loop; + end; + when Type_Record => + for I in Typ.Rec.E'Range loop + declare + E : Rec_El_Type renames Typ.Rec.E (I); + begin + Update_Sig_Val (E.Typ, + Sig_Index (Sigs, E.Offs.Net_Off), + Vals + E.Offs.Mem_Off); + end; + end loop; + when others => + raise Internal_Error; + end case; + end Update_Sig_Val; + + procedure Update_Signal_Individual_Assocs_Values (Inst : Synth_Instance_Acc) + is + Bod : constant Node := Get_Source_Scope (Inst); + Spec : constant Node := Get_Subprogram_Specification (Bod); + Inter : Node; + Obj : Valtyp; + begin + Inter := Get_Interface_Declaration_Chain (Spec); + while Inter /= Null_Node loop + Obj := Get_Value (Inst, Inter); + if Obj.Val.Kind = Value_Sig_Val then + Update_Sig_Val (Obj.Typ, Obj.Val.I_Sigs, Obj.Val.I_Vals); + end if; + Inter := Get_Chain (Inter); + end loop; + end Update_Signal_Individual_Assocs_Values; + + function Hook_Create_Value_For_Signal_Individual_Assocs + (Inst : Synth_Instance_Acc; + Assocs : Assoc_Array; + Typ : Type_Acc) return Valtyp + is + Sigs : Memory_Ptr; + Vals : Memory_Ptr; + begin + Set_Indiv_Signal_Assoc_Flag (Inst); + + Sigs := Alloc_Signal_Memory (Typ, Instance_Pool); + for I in Assocs'Range loop + declare + A : Assoc_Record renames Assocs (I); + begin + -- TODO: individual assoc using individual assoc formal. + Copy_Memory + (Sig_Index (Sigs, A.Form_Off.Net_Off), + Sig_Index (Exec_Sig_Sig (A.Act_Base.Val), A.Act_Off.Net_Off), + Size_Type (A.Act_Typ.W) * Sig_Size); + end; + end loop; + + Vals := Alloc_Memory (Typ, Instance_Pool); + Update_Sig_Val (Typ, Sigs, Vals); + + return Create_Value_Sig_Val (Sigs, Vals, Typ, Instance_Pool); + end Hook_Create_Value_For_Signal_Individual_Assocs; + + procedure Create_Terminals is begin for I in Terminal_Table.First .. Terminal_Table.Last loop declare @@ -3588,6 +3781,9 @@ package body Simul.Vhdl_Simul is Synth.Vhdl_Expr.Hook_Signal_Expr := Hook_Signal_Expr'Access; Synth.Vhdl_Expr.Hook_Event_Attribute := Exec_Event_Attribute'Access; Synth.Vhdl_Expr.Hook_Active_Attribute := Exec_Active_Attribute'Access; + Synth.Vhdl_Expr.Hook_Driving_Attribute := Exec_Driving_Attribute'Access; + Synth.Vhdl_Expr.Hook_Driving_Value_Attribute := + Exec_Driving_Value_Attribute'Access; Synth.Vhdl_Expr.Hook_Last_Value_Attribute := Exec_Last_Value_Attribute'Access; Synth.Vhdl_Expr.Hook_Last_Event_Attribute := @@ -3606,6 +3802,9 @@ package body Simul.Vhdl_Simul is Synth.Vhdl_Static_Proc.Hook_Finish := Exec_Finish'Access; + Synth.Vhdl_Stmts.Hook_Create_Value_For_Signal_Individual_Assocs := + Hook_Create_Value_For_Signal_Individual_Assocs'Access; + -- if Flag_Interractive then -- Debug (Reason_Elab); -- end if; |