diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/ghdldrv/ghdlsimul.adb | 2 | ||||
| -rw-r--r-- | src/grt/grt-signals.adb | 11 | ||||
| -rw-r--r-- | src/grt/grt-signals.ads | 3 | ||||
| -rw-r--r-- | src/grt/grt-strings.adb | 3 | ||||
| -rw-r--r-- | src/grt/grt-strings.ads | 4 | ||||
| -rw-r--r-- | src/simul/simul-vhdl_elab.adb | 9 | ||||
| -rw-r--r-- | src/simul/simul-vhdl_simul.adb | 287 | ||||
| -rw-r--r-- | src/synth/elab-vhdl_context.adb | 43 | ||||
| -rw-r--r-- | src/synth/elab-vhdl_context.ads | 25 | ||||
| -rw-r--r-- | src/synth/elab-vhdl_debug.adb | 2 | ||||
| -rw-r--r-- | src/synth/elab-vhdl_expr.adb | 128 | ||||
| -rw-r--r-- | src/synth/elab-vhdl_expr.ads | 2 | ||||
| -rw-r--r-- | src/synth/elab-vhdl_insts.adb | 10 | ||||
| -rw-r--r-- | src/synth/elab-vhdl_values-debug.adb | 3 | ||||
| -rw-r--r-- | src/synth/elab-vhdl_values.adb | 26 | ||||
| -rw-r--r-- | src/synth/elab-vhdl_values.ads | 13 | ||||
| -rw-r--r-- | src/synth/synth-vhdl_context.adb | 3 | ||||
| -rw-r--r-- | src/synth/synth-vhdl_expr.adb | 39 | ||||
| -rw-r--r-- | src/synth/synth-vhdl_expr.ads | 2 | ||||
| -rw-r--r-- | src/synth/synth-vhdl_insts.adb | 3 | ||||
| -rw-r--r-- | src/synth/synth-vhdl_oper.adb | 14 | ||||
| -rw-r--r-- | src/synth/synth-vhdl_stmts.adb | 37 | ||||
| -rw-r--r-- | src/synth/synth-vhdl_stmts.ads | 19 | ||||
| -rw-r--r-- | src/vhdl/vhdl-canon.adb | 1 |
24 files changed, 595 insertions, 94 deletions
diff --git a/src/ghdldrv/ghdlsimul.adb b/src/ghdldrv/ghdlsimul.adb index 08377c1e1..1e5c0f557 100644 --- a/src/ghdldrv/ghdlsimul.adb +++ b/src/ghdldrv/ghdlsimul.adb @@ -79,7 +79,7 @@ package body Ghdlsimul is Lib_Unit : Node; Inst : Synth_Instance_Acc; begin - Common_Compile_Elab (Cmd_Name, Args, False, Opt_Arg, Config); + Common_Compile_Elab (Cmd_Name, Args, True, Opt_Arg, Config); for I in Opt_Arg .. Args'Last loop if Args (I).all = "--expect-failure" then diff --git a/src/grt/grt-signals.adb b/src/grt/grt-signals.adb index 5c542a38e..b81a86fd3 100644 --- a/src/grt/grt-signals.adb +++ b/src/grt/grt-signals.adb @@ -1803,7 +1803,8 @@ package body Grt.Signals is end if; end Ghdl_Signal_Driving; - function Ghdl_Signal_Driving_Value_B1 (Sig : Ghdl_Signal_Ptr) return Ghdl_B1 + function Ghdl_Signal_Driving_Value (Sig : Ghdl_Signal_Ptr) + return Value_Union is Drv : Driver_Acc; begin @@ -1811,8 +1812,14 @@ package body Grt.Signals is if Drv = null or else Drv.First_Trans.Kind /= Trans_Value then Error ("'driving_value: no active driver in process for signal"); else - return Drv.First_Trans.Val.B1; + return Drv.First_Trans.Val; end if; + end Ghdl_Signal_Driving_Value; + + function Ghdl_Signal_Driving_Value_B1 (Sig : Ghdl_Signal_Ptr) + return Ghdl_B1 is + begin + return Ghdl_Signal_Driving_Value (Sig).B1; end Ghdl_Signal_Driving_Value_B1; function Ghdl_Signal_Driving_Value_E8 (Sig : Ghdl_Signal_Ptr) diff --git a/src/grt/grt-signals.ads b/src/grt/grt-signals.ads index 618ec8805..76977d37a 100644 --- a/src/grt/grt-signals.ads +++ b/src/grt/grt-signals.ads @@ -599,6 +599,9 @@ package Grt.Signals is function Ghdl_Signal_Driving (Sig : Ghdl_Signal_Ptr) return Ghdl_B1; + function Ghdl_Signal_Driving_Value (Sig : Ghdl_Signal_Ptr) + return Value_Union; + -- Generic version. procedure Ghdl_Signal_Start_Assign_Any (Sign : Ghdl_Signal_Ptr; Rej : Std_Time; diff --git a/src/grt/grt-strings.adb b/src/grt/grt-strings.adb index 5d6fc8706..3f8f8ed29 100644 --- a/src/grt/grt-strings.adb +++ b/src/grt/grt-strings.adb @@ -23,9 +23,8 @@ package body Grt.Strings is function Is_Whitespace (C : in Character) return Boolean is - use ASCII; begin - return C = ' ' or C = NBSP or C = HT; + return C = ' ' or C = NBSP; end Is_Whitespace; function First_Non_Whitespace_Pos (Str : String) return Integer is diff --git a/src/grt/grt-strings.ads b/src/grt/grt-strings.ads index 7b8535425..1d52a62fc 100644 --- a/src/grt/grt-strings.ads +++ b/src/grt/grt-strings.ads @@ -26,7 +26,9 @@ package Grt.Strings is NBSP : constant Character := Character'Val (160); - -- Return True IFF C is a whitespace character (as defined in LRM93 14.3) + -- Return True IFF C is a whitespace character as defined by LRM93 13.1 + -- Note: this is different from the definition in LRM93 14.3 (for files, + -- which includes HT). function Is_Whitespace (C : in Character) return Boolean; -- The following functions return -1 in case there is no match in string --- diff --git a/src/simul/simul-vhdl_elab.adb b/src/simul/simul-vhdl_elab.adb index 5c41511d6..36bc1df23 100644 --- a/src/simul/simul-vhdl_elab.adb +++ b/src/simul/simul-vhdl_elab.adb @@ -360,6 +360,15 @@ package body Simul.Vhdl_Elab is No_Sensitivity_Index, No_Signal_Index, No_Connect_Index, T, Pfx)); end; + when Iir_Kind_Transaction_Attribute => + declare + Pfx : Sub_Signal_Type; + begin + Pfx := Compute_Sub_Signal (Inst, Get_Prefix (Decl)); + Gather_Signal ((Mode_Transaction, Decl, Inst, null, null, null, + No_Sensitivity_Index, No_Signal_Index, + No_Connect_Index, 0, Pfx)); + end; when Iir_Kind_Delayed_Attribute => declare T : Std_Time; 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; diff --git a/src/synth/elab-vhdl_context.adb b/src/synth/elab-vhdl_context.adb index 136cc50f0..56de0563e 100644 --- a/src/synth/elab-vhdl_context.adb +++ b/src/synth/elab-vhdl_context.adb @@ -53,6 +53,7 @@ package body Elab.Vhdl_Context is new Synth_Instance_Type'(Max_Objs => Global_Info.Nbr_Objects, Is_Const => False, Is_Error => False, + Flag1 | Flag2 => False, Id => Inst_Tables.Last + 1, Block_Scope => Global_Info, Up_Block => null, @@ -101,6 +102,7 @@ package body Elab.Vhdl_Context is Res := new Synth_Instance_Type'(Max_Objs => Nbr_Objs, Is_Const => False, Is_Error => False, + Flag1 | Flag2 => False, Id => Inst_Tables.Last + 1, Block_Scope => Scope, Up_Block => Parent, @@ -142,6 +144,7 @@ package body Elab.Vhdl_Context is Res := new Synth_Instance_Type'(Max_Objs => Object_Slot_Type (Len), Is_Const => False, Is_Error => False, + Flag1 | Flag2 => False, Id => Inst_Tables.Last + 1, Block_Scope => Info, Up_Block => Parent, @@ -237,6 +240,28 @@ package body Elab.Vhdl_Context is return Inst.Foreign; end Get_Instance_Foreign; + procedure Set_Indiv_Signal_Assoc_Flag (Inst : Synth_Instance_Acc) is + begin + Inst.Flag1 := True; + end Set_Indiv_Signal_Assoc_Flag; + + function Get_Indiv_Signal_Assoc_Flag (Inst : Synth_Instance_Acc) + return Boolean is + begin + return Inst.Flag1; + end Get_Indiv_Signal_Assoc_Flag; + + procedure Set_Indiv_Signal_Assoc_Parent_Flag (Inst : Synth_Instance_Acc) is + begin + Inst.Flag2 := True; + end Set_Indiv_Signal_Assoc_Parent_Flag; + + function Get_Indiv_Signal_Assoc_Parent_Flag (Inst : Synth_Instance_Acc) + return Boolean is + begin + return Inst.Flag2; + end Get_Indiv_Signal_Assoc_Parent_Flag; + procedure Add_Extra_Instance (Inst : Synth_Instance_Acc; Extra : Synth_Instance_Acc) is begin @@ -590,15 +615,21 @@ package body Elab.Vhdl_Context is end case; end Get_Instance_By_Scope; - function Get_Parent_Scope (Blk : Node) return Sim_Info_Acc + function Get_Info_Scope (Blk : Node) return Sim_Info_Acc is - Parent : Node; + N : Node; begin - Parent := Get_Parent (Blk); - if Get_Kind (Parent) = Iir_Kind_Architecture_Body then - Parent := Vhdl.Utils.Get_Entity (Parent); + if Get_Kind (Blk) = Iir_Kind_Architecture_Body then + N := Vhdl.Utils.Get_Entity (Blk); + else + N := Blk; end if; - return Get_Info (Parent); + return Get_Info (N); + end Get_Info_Scope; + + function Get_Parent_Scope (Blk : Node) return Sim_Info_Acc is + begin + return Get_Info_Scope (Get_Parent (Blk)); end Get_Parent_Scope; function Get_Value (Syn_Inst: Synth_Instance_Acc; Obj : Node) diff --git a/src/synth/elab-vhdl_context.ads b/src/synth/elab-vhdl_context.ads index 8598bbf56..3a85cd089 100644 --- a/src/synth/elab-vhdl_context.ads +++ b/src/synth/elab-vhdl_context.ads @@ -74,6 +74,8 @@ package Elab.Vhdl_Context is procedure Set_Error (Inst : Synth_Instance_Acc); + -- Get/Set the const flag. + -- This is for subprograms, and set when all parameters are static. function Get_Instance_Const (Inst : Synth_Instance_Acc) return Boolean; procedure Set_Instance_Const (Inst : Synth_Instance_Acc; Val : Boolean); @@ -90,6 +92,19 @@ package Elab.Vhdl_Context is procedure Set_Instance_Foreign (Inst : Synth_Instance_Acc; N : Int32); function Get_Instance_Foreign (Inst : Synth_Instance_Acc) return Int32; + -- For simulation: set a flag if a signal parameter has individual + -- association. In that case, the value of the parameter must be + -- updated after a wait statement. + procedure Set_Indiv_Signal_Assoc_Flag (Inst : Synth_Instance_Acc); + function Get_Indiv_Signal_Assoc_Flag (Inst : Synth_Instance_Acc) + return Boolean; + + -- For simulation: set if a parent has the Indiv_Signal_Assoc_Flag set. + -- In that case, update must continue in the parent. + procedure Set_Indiv_Signal_Assoc_Parent_Flag (Inst : Synth_Instance_Acc); + function Get_Indiv_Signal_Assoc_Parent_Flag (Inst : Synth_Instance_Acc) + return Boolean; + -- Add/Get extra instances. -- Those instances are verification units. procedure Add_Extra_Instance (Inst : Synth_Instance_Acc; @@ -175,6 +190,9 @@ package Elab.Vhdl_Context is function Get_Component_Instance (Syn_Inst : Synth_Instance_Acc) return Synth_Instance_Acc; + -- Return the scope of BLK. Deals with architecture bodies. + function Get_Info_Scope (Blk : Node) return Sim_Info_Acc; + -- Return the scope of the parent of BLK. Deals with architecture bodies. function Get_Parent_Scope (Blk : Node) return Sim_Info_Acc; @@ -233,6 +251,13 @@ private -- of this instance. Is_Error : Boolean; + -- For simulation: set if a subprogram has a signal parameter + -- associated by individual elements. + Flag1 : Boolean; + + -- For simulation: set if a parent instance has Flag1 set. + Flag2 : Boolean; + Id : Instance_Id_Type; -- The corresponding info for this instance. diff --git a/src/synth/elab-vhdl_debug.adb b/src/synth/elab-vhdl_debug.adb index d47c310f0..e5e40011e 100644 --- a/src/synth/elab-vhdl_debug.adb +++ b/src/synth/elab-vhdl_debug.adb @@ -280,6 +280,8 @@ package body Elab.Vhdl_Debug is Disp_Memtyp (Get_Memtyp (Vt), Vtype); when Value_Dyn_Alias => Put ("dyn alias"); + when Value_Sig_Val => + Put ("sig val"); when Value_Memory => Disp_Memtyp (Get_Memtyp (Vt), Vtype); end case; diff --git a/src/synth/elab-vhdl_expr.adb b/src/synth/elab-vhdl_expr.adb index ee15c7e52..d9ad9f27d 100644 --- a/src/synth/elab-vhdl_expr.adb +++ b/src/synth/elab-vhdl_expr.adb @@ -23,6 +23,7 @@ with Str_Table; with Netlists; with Vhdl.Errors; use Vhdl.Errors; +with Vhdl.Scanner; with Vhdl.Utils; use Vhdl.Utils; with Vhdl.Evaluation; use Vhdl.Evaluation; @@ -36,7 +37,9 @@ with Synth.Vhdl_Eval; use Synth.Vhdl_Eval; with Synth.Errors; use Synth.Errors; with Grt.Types; +with Grt.Vhdl_Types; with Grt.To_Strings; +with Grt.Vstrings; package body Elab.Vhdl_Expr is function Synth_Bounds_From_Length (Atype : Node; Len : Int32) @@ -124,17 +127,48 @@ package body Elab.Vhdl_Expr is end if; declare - Str : constant String := Value_To_String (V); + Value : constant String := Value_To_String (V); + First, Last : Integer; Res_N : Node; Val : Int64; begin + -- LRM93 14.1 Predefined attributes. + -- Leading and trailing whitespace are ignored. + First := Value'First; + Last := Value'Last; + while First <= Last loop + exit when not Vhdl.Scanner.Is_Whitespace (Value (First)); + First := First + 1; + end loop; + while Last >= First loop + exit when not Vhdl.Scanner.Is_Whitespace (Value (Last)); + Last := Last - 1; + end loop; + case Get_Kind (Btype) is when Iir_Kind_Enumeration_Type_Definition => - Res_N := Eval_Value_Attribute (Str, Etype, Attr); + Res_N := Eval_Value_Attribute + (Value (First .. Last), Etype, Attr); Val := Int64 (Get_Enum_Pos (Res_N)); Free_Iir (Res_N); when Iir_Kind_Integer_Type_Definition => - Val := Int64'Value (Str); + declare + use Grt.To_Strings; + use Grt.Types; + use Grt.Vhdl_Types; + Value1 : String renames Value (First .. Last); + Res : Value_I64_Result; + begin + Res := Value_I64 (To_Std_String_Basep (Value1'Address), + Value1'Length, 0); + if Res.Status = Value_Ok then + Val := Int64 (Res.Val); + else + Error_Msg_Synth + (Syn_Inst, Attr, "incorrect 'value string"); + return No_Valtyp; + end if; + end; when others => Error_Msg_Elab (+Attr, "unhandled type for 'value"); return No_Valtyp; @@ -420,4 +454,92 @@ package body Elab.Vhdl_Expr is return Res; end Exec_String_Literal; + function Exec_Path_Instance_Name_Attribute + (Inst : Synth_Instance_Acc; Attr : Iir) return Memtyp + is + use Grt.Vstrings; + use Name_Table; + + Is_Instance : constant Boolean := + Get_Kind (Attr) = Iir_Kind_Instance_Name_Attribute; + + Atype : constant Node := Get_Type (Attr); + Str_Typ : constant Type_Acc := Get_Subtype_Object (Inst, Atype); + Name : constant Path_Instance_Name_Type := + Get_Path_Instance_Name_Suffix (Attr); + Instance, Parent : Synth_Instance_Acc; + Rstr : Rstring; + Label : Node; + begin + if Name.Path_Instance = Null_Iir then + return String_To_Memtyp (Name.Suffix, Str_Typ); + end if; + + Instance := Get_Instance_By_Scope + (Inst, Get_Info_Scope (Name.Path_Instance)); + + loop + Parent := Get_Instance_Parent (Instance); + if Parent = Root_Instance then + Parent := null; + end if; + Label := Get_Source_Scope (Instance); + + case Get_Kind (Label) is + when Iir_Kind_Entity_Declaration => + if Parent = null then + Prepend (Rstr, Image (Get_Identifier (Label))); + exit; + end if; + when Iir_Kind_Architecture_Body => + if Is_Instance then + Prepend (Rstr, ')'); + Prepend (Rstr, Image (Get_Identifier (Label))); + Prepend (Rstr, '('); + end if; + + if Is_Instance or else Parent = null then + Prepend (Rstr, Image (Get_Identifier (Get_Entity (Label)))); + end if; + if Parent = null then + Prepend (Rstr, ':'); + exit; + end if; + when Iir_Kind_Block_Statement => + Prepend (Rstr, Image (Get_Label (Label))); + Prepend (Rstr, ':'); + when Iir_Kind_Iterator_Declaration => + declare + Val : Valtyp; + begin + Val := Get_Value (Instance, Label); + Prepend (Rstr, ')'); + Prepend (Rstr, + Synth_Image_Attribute_Str (Val, Get_Type (Label))); + Prepend (Rstr, '('); + end; + when Iir_Kind_Generate_Statement_Body => + Prepend (Rstr, Image (Get_Label (Get_Parent (Label)))); + Prepend (Rstr, ':'); + when Iir_Kind_Component_Instantiation_Statement => + if Is_Instance then + Prepend (Rstr, '@'); + end if; + Prepend (Rstr, Image (Get_Label (Label))); + Prepend (Rstr, ':'); + when others => + Error_Kind ("Execute_Path_Instance_Name_Attribute", + Label); + end case; + Instance := Parent; + end loop; + declare + Str1 : String (1 .. Length (Rstr)); + Len1 : Natural; + begin + Copy (Rstr, Str1, Len1); + Free (Rstr); + return String_To_Memtyp (Str1 & ':' & Name.Suffix, Str_Typ); + end; + end Exec_Path_Instance_Name_Attribute; end Elab.Vhdl_Expr; diff --git a/src/synth/elab-vhdl_expr.ads b/src/synth/elab-vhdl_expr.ads index 3ef89d02c..244f89154 100644 --- a/src/synth/elab-vhdl_expr.ads +++ b/src/synth/elab-vhdl_expr.ads @@ -55,6 +55,8 @@ package Elab.Vhdl_Expr is return Valtyp; function Exec_Instance_Name_Attribute (Syn_Inst : Synth_Instance_Acc; Attr : Node) return Valtyp; + function Exec_Path_Instance_Name_Attribute + (Inst : Synth_Instance_Acc; Attr : Iir) return Memtyp; function Exec_Simple_Aggregate (Syn_Inst : Synth_Instance_Acc; Aggr : Node) return Valtyp; diff --git a/src/synth/elab-vhdl_insts.adb b/src/synth/elab-vhdl_insts.adb index be7d5a7d5..389a816a4 100644 --- a/src/synth/elab-vhdl_insts.adb +++ b/src/synth/elab-vhdl_insts.adb @@ -910,11 +910,17 @@ package body Elab.Vhdl_Insts is Em : Mark_Type; Val : Valtyp; Inter_Typ : Type_Acc; + Defval : Node; begin Mark_Expr_Pool (Em); Inter_Typ := Elab_Declaration_Type (Top_Inst, Inter); - Val := Synth_Expression_With_Type - (Top_Inst, Get_Default_Value (Inter), Inter_Typ); + Defval := Get_Default_Value (Inter); + if Defval /= Null_Node then + Val := Synth_Expression_With_Type (Top_Inst, Defval, Inter_Typ); + else + -- Only for simulation, expect override. + Val := Create_Value_Default (Inter_Typ); + end if; pragma Assert (Is_Static (Val.Val)); Val := Unshare (Val, Instance_Pool); Val.Typ := Unshare_Type_Instance (Val.Typ, Inter_Typ); diff --git a/src/synth/elab-vhdl_values-debug.adb b/src/synth/elab-vhdl_values-debug.adb index aec0b1e20..c995c0204 100644 --- a/src/synth/elab-vhdl_values-debug.adb +++ b/src/synth/elab-vhdl_values-debug.adb @@ -324,6 +324,9 @@ package body Elab.Vhdl_Values.Debug is when Value_Dyn_Alias => Put ("dyn alias: "); Debug_Typ1 (V.Typ); + when Value_Sig_Val => + Put ("sig val: "); + Debug_Typ1 (V.Typ); end case; end Debug_Valtyp; diff --git a/src/synth/elab-vhdl_values.adb b/src/synth/elab-vhdl_values.adb index 045fcce2e..deb0d0ccb 100644 --- a/src/synth/elab-vhdl_values.adb +++ b/src/synth/elab-vhdl_values.adb @@ -34,6 +34,7 @@ package body Elab.Vhdl_Values is | Value_Wire | Value_Signal | Value_Dyn_Alias + | Value_Sig_Val | Value_Quantity | Value_Terminal => return False; @@ -268,6 +269,26 @@ package body Elab.Vhdl_Values is end if; end Strip_Const; + function Create_Value_Sig_Val (Sigs : Memory_Ptr; + Vals : Memory_Ptr; + Pool : Areapool_Acc) return Value_Acc + is + subtype Value_Type_Sig_Val is Value_Type (Value_Sig_Val); + function Alloc is new Areapools.Alloc_On_Pool_Addr (Value_Type_Sig_Val); + begin + return To_Value_Acc (Alloc (Pool, (Kind => Value_Sig_Val, + I_Sigs => Sigs, + I_Vals => Vals))); + end Create_Value_Sig_Val; + + function Create_Value_Sig_Val (Sigs : Memory_Ptr; + Vals : Memory_Ptr; + Typ : Type_Acc; + Pool : Areapool_Acc) return Valtyp is + begin + return (Typ, Create_Value_Sig_Val (Sigs, Vals, Pool)); + end Create_Value_Sig_Val; + procedure Write_Value (Dest : Memory_Ptr; Vt : Valtyp) is Mt : Memtyp; @@ -315,6 +336,8 @@ package body Elab.Vhdl_Values is Src.Val.D_Poff, Src.Val.D_Ptyp, Src.Val.D_Voff, Src.Val.D_Eoff, Current_Pool)); + when Value_Sig_Val => + raise Internal_Error; end case; return Res; end Copy; @@ -545,7 +568,8 @@ package body Elab.Vhdl_Values is when Value_Net | Value_Wire | Value_Signal - | Value_Dyn_Alias => + | Value_Dyn_Alias + | Value_Sig_Val => raise Internal_Error; when Value_Memory => return (V.Typ, V.Val.Mem); diff --git a/src/synth/elab-vhdl_values.ads b/src/synth/elab-vhdl_values.ads index 4ed86da22..0e72fd128 100644 --- a/src/synth/elab-vhdl_values.ads +++ b/src/synth/elab-vhdl_values.ads @@ -60,7 +60,10 @@ package Elab.Vhdl_Values is Value_Alias, -- Used only for associations. - Value_Dyn_Alias + Value_Dyn_Alias, + + -- Used only for individual signal associations in simulation + Value_Sig_Val ); type Value_Type (Kind : Value_Kind); @@ -114,6 +117,9 @@ package Elab.Vhdl_Values is D_Ptyp : Type_Acc; -- Type of the prefix (after offset). D_Voff : Uns32; -- Variable offset D_Eoff : Uns32; -- Fixed offset. + when Value_Sig_Val => + I_Sigs : Memory_Ptr; + I_Vals : Memory_Ptr; end case; end record; @@ -187,6 +193,11 @@ package Elab.Vhdl_Values is function Create_Value_Const (Val : Valtyp; Loc : Node; Pool : Areapool_Acc) return Valtyp; + function Create_Value_Sig_Val (Sigs : Memory_Ptr; + Vals : Memory_Ptr; + Typ : Type_Acc; + Pool : Areapool_Acc) return Valtyp; + -- If VAL is a const, replace it by its value. procedure Strip_Const (Vt : in out Valtyp); diff --git a/src/synth/synth-vhdl_context.adb b/src/synth/synth-vhdl_context.adb index 81143bea9..7d05e203a 100644 --- a/src/synth/synth-vhdl_context.adb +++ b/src/synth/synth-vhdl_context.adb @@ -464,7 +464,8 @@ package body Synth.Vhdl_Context is return True; when Value_Net | Value_Signal - | Value_Dyn_Alias => + | Value_Dyn_Alias + | Value_Sig_Val => return False; when Value_Quantity | Value_Terminal => diff --git a/src/synth/synth-vhdl_expr.adb b/src/synth/synth-vhdl_expr.adb index 036e5a27e..6e397aa1a 100644 --- a/src/synth/synth-vhdl_expr.adb +++ b/src/synth/synth-vhdl_expr.adb @@ -2060,6 +2060,7 @@ package body Synth.Vhdl_Expr is Res := Synth_Name (Syn_Inst, Expr); if Res.Val /= null then if (Res.Val.Kind = Value_Signal + or else Res.Val.Kind = Value_Sig_Val or else (Res.Val.Kind = Value_Alias and then Res.Val.A_Obj.Kind = Value_Signal)) then @@ -2316,6 +2317,7 @@ package body Synth.Vhdl_Expr is declare Param : constant Node := Get_Parameter (Expr); V : Valtyp; + Vi : Int64; Dtype : Type_Acc; begin Dtype := Get_Subtype_Object (Syn_Inst, Get_Type (Expr)); @@ -2323,10 +2325,16 @@ package body Synth.Vhdl_Expr is -- FIXME: to be generalized. Not always as simple as a -- subtype conversion. if Is_Static (V.Val) then - V := Create_Value_Discrete (Read_Discrete (V), Dtype); + Vi := Read_Discrete (V); + if not In_Range (Dtype.Drange, Vi) then + Error_Msg_Synth (Syn_Inst, Expr, "value out of range"); + return No_Valtyp; + end if; + return Create_Value_Discrete (Vi, Dtype); + else + return Synth_Subtype_Conversion + (Syn_Inst, V, Dtype, False, Expr); end if; - return Synth_Subtype_Conversion - (Syn_Inst, V, Dtype, False, Expr); end; when Iir_Kind_Low_Type_Attribute => return Synth_Low_High_Type_Attribute (Syn_Inst, Expr, Dir_To); @@ -2366,9 +2374,15 @@ package body Synth.Vhdl_Expr is return Elab.Vhdl_Expr.Exec_Value_Attribute (Syn_Inst, Expr); when Iir_Kind_Image_Attribute => return Elab.Vhdl_Expr.Exec_Image_Attribute (Syn_Inst, Expr); - when Iir_Kind_Instance_Name_Attribute => - return Elab.Vhdl_Expr.Exec_Instance_Name_Attribute - (Syn_Inst, Expr); + when Iir_Kind_Path_Name_Attribute + | Iir_Kind_Instance_Name_Attribute => + declare + Mt : Memtyp; + begin + Mt := Elab.Vhdl_Expr.Exec_Path_Instance_Name_Attribute + (Syn_Inst, Expr); + return Create_Value_Memtyp (Mt); + end; when Iir_Kind_Null_Literal => return Create_Value_Access (Null_Heap_Index, Expr_Type); when Iir_Kind_Allocator_By_Subtype => @@ -2422,6 +2436,19 @@ package body Synth.Vhdl_Expr is end if; Error_Msg_Synth (Syn_Inst, Expr, "active attribute not allowed"); return No_Valtyp; + when Iir_Kind_Driving_Attribute => + if Hook_Driving_Attribute /= null then + return Hook_Driving_Attribute (Syn_Inst, Expr); + end if; + Error_Msg_Synth (Syn_Inst, Expr, "driving attribute not allowed"); + return No_Valtyp; + when Iir_Kind_Driving_Value_Attribute => + if Hook_Driving_Value_Attribute /= null then + return Hook_Driving_Value_Attribute (Syn_Inst, Expr); + end if; + Error_Msg_Synth (Syn_Inst, Expr, + "driving_value attribute not allowed"); + return No_Valtyp; when Iir_Kind_Last_Value_Attribute => if Hook_Last_Value_Attribute /= null then return Hook_Last_Value_Attribute (Syn_Inst, Expr); diff --git a/src/synth/synth-vhdl_expr.ads b/src/synth/synth-vhdl_expr.ads index 74412fe22..c991f388a 100644 --- a/src/synth/synth-vhdl_expr.ads +++ b/src/synth/synth-vhdl_expr.ads @@ -89,6 +89,8 @@ package Synth.Vhdl_Expr is function (Syn_Inst : Synth_Instance_Acc; Expr : Node) return Valtyp; Hook_Event_Attribute : Hook_Attribute_Acc; Hook_Active_Attribute : Hook_Attribute_Acc; + Hook_Driving_Attribute : Hook_Attribute_Acc; + Hook_Driving_Value_Attribute : Hook_Attribute_Acc; Hook_Last_Value_Attribute : Hook_Attribute_Acc; Hook_Last_Event_Attribute : Hook_Attribute_Acc; Hook_Last_Active_Attribute : Hook_Attribute_Acc; diff --git a/src/synth/synth-vhdl_insts.adb b/src/synth/synth-vhdl_insts.adb index fc9788f78..88f023354 100644 --- a/src/synth/synth-vhdl_insts.adb +++ b/src/synth/synth-vhdl_insts.adb @@ -230,7 +230,8 @@ package body Synth.Vhdl_Insts is | Value_File | Value_Quantity | Value_Terminal - | Value_Dyn_Alias => + | Value_Dyn_Alias + | Value_Sig_Val => raise Internal_Error; end case; end Hash_Const; diff --git a/src/synth/synth-vhdl_oper.adb b/src/synth/synth-vhdl_oper.adb index b46a8ec57..5d5d9cb5c 100644 --- a/src/synth/synth-vhdl_oper.adb +++ b/src/synth/synth-vhdl_oper.adb @@ -1449,6 +1449,7 @@ package body Synth.Vhdl_Oper is | Iir_Predefined_Ieee_Numeric_Std_Add_Uns_Log | Iir_Predefined_Ieee_Numeric_Std_Add_Sgn_Log | Iir_Predefined_Ieee_Numeric_Std_Add_Log_Sgn + | Iir_Predefined_Ieee_Numeric_Std_Unsigned_Add_Slv_Slv | Iir_Predefined_Ieee_Std_Logic_Unsigned_Add_Slv_Log | Iir_Predefined_Ieee_Std_Logic_Unsigned_Add_Log_Slv | Iir_Predefined_Ieee_Std_Logic_Unsigned_Add_Slv_Slv @@ -1466,7 +1467,8 @@ package body Synth.Vhdl_Oper is | Iir_Predefined_Ieee_Std_Logic_Arith_Add_Log_Sgn_Slv => -- "+" (Unsigned, Unsigned) return Synth_Dyadic_Uns_Uns (Ctxt, Id_Add, L, R, Expr); - when Iir_Predefined_Ieee_Numeric_Std_Add_Uns_Nat => + when Iir_Predefined_Ieee_Numeric_Std_Add_Uns_Nat + | Iir_Predefined_Ieee_Numeric_Std_Unsigned_Add_Slv_Nat => -- "+" (Unsigned, Natural) return Synth_Dyadic_Uns_Nat (Ctxt, Id_Add, L, R, Expr); when Iir_Predefined_Ieee_Std_Logic_Arith_Add_Uns_Int_Slv @@ -1475,6 +1477,7 @@ package body Synth.Vhdl_Oper is -- "+" (Unsigned, Integer) return Synth_Dyadic_Sgn_Int (Ctxt, Id_Add, L, R, Expr); when Iir_Predefined_Ieee_Numeric_Std_Add_Nat_Uns + | Iir_Predefined_Ieee_Numeric_Std_Unsigned_Add_Nat_Slv | Iir_Predefined_Ieee_Std_Logic_Arith_Add_Int_Uns_Uns | Iir_Predefined_Ieee_Std_Logic_Arith_Add_Int_Uns_Slv | Iir_Predefined_Ieee_Std_Logic_Unsigned_Add_Int_Slv => @@ -1511,6 +1514,7 @@ package body Synth.Vhdl_Oper is | Iir_Predefined_Ieee_Numeric_Std_Sub_Uns_Log | Iir_Predefined_Ieee_Numeric_Std_Sub_Sgn_Log | Iir_Predefined_Ieee_Numeric_Std_Sub_Log_Sgn + | Iir_Predefined_Ieee_Numeric_Std_Unsigned_Sub_Slv_Slv | Iir_Predefined_Ieee_Std_Logic_Unsigned_Sub_Slv_Slv | Iir_Predefined_Ieee_Std_Logic_Unsigned_Sub_Log_Slv | Iir_Predefined_Ieee_Std_Logic_Unsigned_Sub_Slv_Log @@ -1534,7 +1538,8 @@ package body Synth.Vhdl_Oper is | Iir_Predefined_Ieee_Std_Logic_Signed_Sub_Slv_Slv => -- "-" (Signed, Signed) return Synth_Dyadic_Sgn_Sgn (Ctxt, Id_Sub, L, R, Expr); - when Iir_Predefined_Ieee_Numeric_Std_Sub_Uns_Nat => + when Iir_Predefined_Ieee_Numeric_Std_Sub_Uns_Nat + | Iir_Predefined_Ieee_Numeric_Std_Unsigned_Sub_Slv_Nat => -- "-" (Unsigned, Natural) return Synth_Dyadic_Uns_Nat (Ctxt, Id_Sub, L, R, Expr); when Iir_Predefined_Ieee_Std_Logic_Arith_Sub_Uns_Int_Uns @@ -1543,6 +1548,7 @@ package body Synth.Vhdl_Oper is -- "-" (Unsigned, Integer) return Synth_Dyadic_Sgn_Int (Ctxt, Id_Sub, L, R, Expr); when Iir_Predefined_Ieee_Numeric_Std_Sub_Nat_Uns + | Iir_Predefined_Ieee_Numeric_Std_Unsigned_Sub_Nat_Slv | Iir_Predefined_Ieee_Std_Logic_Arith_Sub_Int_Uns_Uns | Iir_Predefined_Ieee_Std_Logic_Arith_Sub_Int_Uns_Slv | Iir_Predefined_Ieee_Std_Logic_Unsigned_Sub_Int_Slv => @@ -1985,7 +1991,8 @@ package body Synth.Vhdl_Oper is | Iir_Predefined_Ieee_Numeric_Std_To_01_Uns | Iir_Predefined_Ieee_Numeric_Std_To_01_Sgn | Iir_Predefined_Ieee_1164_To_X01_Slv - | Iir_Predefined_Ieee_1164_To_UX01_Slv => + | Iir_Predefined_Ieee_1164_To_UX01_Slv + | Iir_Predefined_Ieee_1164_To_X01Z_Slv => if Is_Static (L.Val) then raise Internal_Error; end if; @@ -1994,6 +2001,7 @@ package body Synth.Vhdl_Oper is when Iir_Predefined_Ieee_1164_To_Bit | Iir_Predefined_Ieee_1164_To_X01_Log | Iir_Predefined_Ieee_1164_To_UX01_Log + | Iir_Predefined_Ieee_1164_To_X01Z_Log | Iir_Predefined_Ieee_1164_To_Stdulogic => -- A no-op. return Create_Value_Net (Get_Net (Ctxt, L), Res_Typ); diff --git a/src/synth/synth-vhdl_stmts.adb b/src/synth/synth-vhdl_stmts.adb index 58e04afad..bba8c823b 100644 --- a/src/synth/synth-vhdl_stmts.adb +++ b/src/synth/synth-vhdl_stmts.adb @@ -466,7 +466,8 @@ package body Synth.Vhdl_Stmts is -- Need to reverse offsets. Copy_Memory (Res.Val.Mem, - Val.Val.Mem + (Val.Typ.Sz - Size_Type (Off + 1) * El_Typ.Sz), + Val.Val.Mem + + (Val.Typ.Sz - Typ.Sz - Size_Type (Off) * El_Typ.Sz), Typ.Sz); return Res; end; @@ -769,7 +770,8 @@ package body Synth.Vhdl_Stmts is | Value_Const | Value_Alias | Value_Dyn_Alias - | Value_Signal => + | Value_Signal + | Value_Sig_Val => raise Internal_Error; end case; when Target_Aggregate => @@ -2030,17 +2032,6 @@ package body Synth.Vhdl_Stmts is return Count; end Count_Individual_Associations; - type Assoc_Record is record - Formal : Node; - Form_Off : Value_Offsets; - - Act_Base : Valtyp; - Act_Typ : Type_Acc; - Act_Off : Value_Offsets; - Act_Dyn : Dyn_Name; - end record; - - type Assoc_Array is array (Natural range <>) of Assoc_Record; type Assoc_Array_Acc is access Assoc_Array; procedure Free_Assoc_Array is new Ada.Unchecked_Deallocation (Assoc_Array, Assoc_Array_Acc); @@ -2144,18 +2135,24 @@ package body Synth.Vhdl_Stmts is A.Act_Typ.Sz); end; end loop; - declare - D : Destroy_Type; - begin - Destroy_Init (D, Subprg_Inst); - Destroy_Object (D, Inter); - Destroy_Finish (D); - end; + elsif Flags.Flag_Simulation then + Res := Hook_Create_Value_For_Signal_Individual_Assocs + (Subprg_Inst, Assocs.all, Formal_Typ); else Res := No_Valtyp; raise Internal_Error; end if; + -- Destroy the object. It will be recreated by + -- Synth_Subprogram_Association. + declare + D : Destroy_Type; + begin + Destroy_Init (D, Subprg_Inst); + Destroy_Object (D, Inter); + Destroy_Finish (D); + end; + Free_Assoc_Array (Assocs); return Res; diff --git a/src/synth/synth-vhdl_stmts.ads b/src/synth/synth-vhdl_stmts.ads index c07dc7224..ac9cd13d8 100644 --- a/src/synth/synth-vhdl_stmts.ads +++ b/src/synth/synth-vhdl_stmts.ads @@ -211,6 +211,25 @@ package Synth.Vhdl_Stmts is Val : Valtyp; Loc : Node); + type Assoc_Record is record + Formal : Node; + Form_Off : Value_Offsets; + + Act_Base : Valtyp; + Act_Typ : Type_Acc; + Act_Off : Value_Offsets; + Act_Dyn : Dyn_Name; + end record; + + type Assoc_Array is array (Natural range <>) of Assoc_Record; + + -- For simulation: create a value for individual signal associations. + type Create_Value_For_Signal_Individual_Assocs_Acc is + access function (Inst : Synth_Instance_Acc; + Assocs : Assoc_Array; + Typ : Type_Acc) return Valtyp; + Hook_Create_Value_For_Signal_Individual_Assocs : + Create_Value_For_Signal_Individual_Assocs_Acc; private -- There are 2 execution mode: diff --git a/src/vhdl/vhdl-canon.adb b/src/vhdl/vhdl-canon.adb index 95f531cf8..8e4bfd588 100644 --- a/src/vhdl/vhdl-canon.adb +++ b/src/vhdl/vhdl-canon.adb @@ -362,6 +362,7 @@ package body Vhdl.Canon is begin We := Chain; while We /= Null_Iir loop + exit when Get_Kind (We) = Iir_Kind_Unaffected_Waveform; Canon_Extract_Sensitivity_Expression (Get_We_Value (We), List); Canon_Extract_Sensitivity_If_Not_Null (Get_Time (We), List); We := Get_Chain (We); |