diff options
| author | Tristan Gingold <tgingold@free.fr> | 2017-10-24 19:20:18 +0200 |
|---|---|---|
| committer | Tristan Gingold <tgingold@free.fr> | 2017-10-24 19:26:47 +0200 |
| commit | f802fc154bba038ea654b17c4c3b3577b1def9ff (patch) | |
| tree | 09ee8f994781dc1b33c208f675144295cf2aea0e /src/vhdl | |
| parent | 91f9de47026f17a105f8cd90ead87b79cf2aa63c (diff) | |
| download | ghdl-f802fc154bba038ea654b17c4c3b3577b1def9ff.tar.gz ghdl-f802fc154bba038ea654b17c4c3b3577b1def9ff.tar.bz2 ghdl-f802fc154bba038ea654b17c4c3b3577b1def9ff.zip | |
simulate: update (and revive).
Diffstat (limited to 'src/vhdl')
| -rw-r--r-- | src/vhdl/simulate/debugger.adb | 1 | ||||
| -rw-r--r-- | src/vhdl/simulate/elaboration.adb | 35 | ||||
| -rw-r--r-- | src/vhdl/simulate/execution.adb | 29 | ||||
| -rw-r--r-- | src/vhdl/simulate/file_operation.adb | 41 | ||||
| -rw-r--r-- | src/vhdl/simulate/file_operation.ads | 11 | ||||
| -rw-r--r-- | src/vhdl/simulate/simulation.adb | 3 |
6 files changed, 87 insertions, 33 deletions
diff --git a/src/vhdl/simulate/debugger.adb b/src/vhdl/simulate/debugger.adb index 058e3c480..75f099c8e 100644 --- a/src/vhdl/simulate/debugger.adb +++ b/src/vhdl/simulate/debugger.adb @@ -137,7 +137,6 @@ package body Debugger is procedure Error_Msg_Exec (Msg: String; Loc: in Iir) is begin Disp_Iir_Location (Loc); - Put (Standard_Error, ' '); Put_Line (Standard_Error, Msg); Grt.Errors.Fatal_Error; end Error_Msg_Exec; diff --git a/src/vhdl/simulate/elaboration.adb b/src/vhdl/simulate/elaboration.adb index 08872c833..ef5db6bdb 100644 --- a/src/vhdl/simulate/elaboration.adb +++ b/src/vhdl/simulate/elaboration.adb @@ -465,13 +465,16 @@ package body Elaboration is if Get_Kind (Design) = Iir_Kind_Entity_Aspect_Entity then -- During Sem, the architecture may be still unknown, and the -- dependency is therefore the aspect. - Library_Unit := Get_Architecture (Design); - if Get_Kind (Library_Unit) in Iir_Kinds_Denoting_Name then - Design := Get_Named_Entity (Library_Unit); - Library_Unit := Get_Library_Unit (Design); - else - Design := Get_Design_Unit (Library_Unit); - end if; + Library_Unit := Strip_Denoting_Name (Get_Architecture (Design)); + case Get_Kind (Library_Unit) is + when Iir_Kind_Architecture_Body => + Design := Get_Design_Unit (Library_Unit); + when Iir_Kind_Design_Unit => + Design := Library_Unit; + Library_Unit := Get_Library_Unit (Design); + when others => + Error_Kind ("elaborate_dependence(1)", Library_Unit); + end case; else Library_Unit := Get_Library_Unit (Design); end if; @@ -1206,16 +1209,17 @@ package body Elaboration is (Formal_Instance : Block_Instance_Acc; Local_Instance : Block_Instance_Acc; Actual_Expr : Iir_Value_Literal_Acc; - Assoc : Iir_Association_Element_By_Expression) + Assoc : Iir_Association_Element_By_Expression; + Inter : Iir) is - Inter : Iir; + Formal : Iir; Actual : Iir; Local_Expr : Iir_Value_Literal_Acc; Formal_Expr : Iir_Value_Literal_Acc; begin - Inter := Get_Formal (Assoc); + Formal := Get_Association_Formal (Assoc, Inter); Actual := Get_Actual (Assoc); - Formal_Expr := Execute_Name (Formal_Instance, Inter, True); + Formal_Expr := Execute_Name (Formal_Instance, Formal, True); Formal_Expr := Unshare_Bounds (Formal_Expr, Global_Pool'Access); if Actual_Expr = null then Local_Expr := Execute_Name (Local_Instance, Actual, True); @@ -1280,7 +1284,7 @@ package body Elaboration is and then Get_Formal_Conversion (Assoc) = Null_Iir then Actual := Get_Actual (Assoc); - Formal := Get_Formal (Assoc); + Formal := Get_Association_Formal (Assoc, Inter); if Is_Signal_Name (Actual) then -- Association with a signal Init_Expr := Execute_Signal_Init_Value @@ -1353,8 +1357,8 @@ package body Elaboration is -- or slice thereof designated by the formal part is then -- associated with the signal or expression designated -- by the actual part. - Elab_Connect - (Formal_Instance, Actual_Instance, Actual_Expr, Assoc); + Elab_Connect (Formal_Instance, Actual_Instance, Actual_Expr, + Assoc, Inter); end if; when Iir_Kind_Association_Element_Open => @@ -1969,7 +1973,8 @@ package body Elaboration is when Iir_Kind_Entity_Aspect_Entity => Entity := Get_Entity (Aspect); if Get_Architecture (Aspect) /= Null_Iir then - Arch_Name := Get_Identifier (Get_Architecture (Aspect)); + Arch_Name := Get_Identifier + (Strip_Denoting_Name (Get_Architecture (Aspect))); end if; when Iir_Kind_Entity_Aspect_Configuration => if Sub_Conf /= Null_Iir then diff --git a/src/vhdl/simulate/execution.adb b/src/vhdl/simulate/execution.adb index 18f42a7bd..ad15360f9 100644 --- a/src/vhdl/simulate/execution.adb +++ b/src/vhdl/simulate/execution.adb @@ -573,7 +573,9 @@ package body Execution is is pragma Unsuppress (Overflow_Check); - Func : Iir_Predefined_Functions; + Imp : constant Iir := Strip_Denoting_Name (Get_Implementation (Expr)); + Func : constant Iir_Predefined_Functions := + Get_Implicit_Definition (Imp); -- Rename definition for monadic operations. Left, Right: Iir_Value_Literal_Acc; @@ -596,15 +598,7 @@ package body Execution is -- Need to copy as the result is modified. Result := Unshare (Left, Expr_Pool'Access); end Eval_Array; - - Imp : Iir; begin - Imp := Get_Implementation (Expr); - if Get_Kind (Imp) in Iir_Kinds_Denoting_Name then - Imp := Get_Named_Entity (Imp); - end if; - Func := Get_Implicit_Definition (Imp); - -- Eval left operand. case Func is when Iir_Predefined_Now_Function => @@ -1566,6 +1560,9 @@ package body Execution is Grt.Lib.Ghdl_Control_Simulation (Args (0).B1, Args (1).B1, Std_Integer (Args (2).I64)); -- Do not return. + when Std_Names.Name_Textio_Write_Real => + File_Operation.Textio_Write_Real + (Args (0), Args (1), Args (2).F64, Std_Integer (Args (3).I64)); when others => Error_Msg_Exec ("unsupported foreign procedure call", Stmt); end case; @@ -3479,8 +3476,8 @@ package body Execution is Assoc_Inter := Inter_Chain; Assoc_Idx := 1; while Assoc /= Null_Iir loop - Formal := Get_Formal (Assoc); Inter := Get_Association_Interface (Assoc, Assoc_Inter); + Formal := Get_Association_Formal (Assoc, Inter); -- Extract the actual value. case Get_Kind (Assoc) is @@ -3635,8 +3632,9 @@ package body Execution is Assoc_Idx := 1; while Assoc /= Null_Iir loop if Get_Kind (Assoc) /= Iir_Kind_Association_Element_By_Individual then - Formal := Get_Formal (Assoc); Inter := Get_Association_Interface (Assoc, Assoc_Inter); + Formal := Get_Association_Formal (Assoc, Inter); + case Get_Kind (Inter) is when Iir_Kind_Interface_Variable_Declaration => if Get_Mode (Inter) /= Iir_In_Mode @@ -3703,17 +3701,20 @@ package body Execution is (Block: Block_Instance_Acc; Expr : Iir; Imp : Iir) return Iir_Value_Literal_Acc is - pragma Unreferenced (Block); + Res : Iir_Value_Literal_Acc; begin case Get_Identifier (Imp) is when Std_Names.Name_Get_Resolution_Limit => - return Create_I64_Value + Res := Create_I64_Value (Ghdl_I64 (Evaluation.Get_Physical_Value (Std_Package.Time_Base))); + when Std_Names.Name_Textio_Read_Real => + Res := Create_F64_Value + (File_Operation.Textio_Read_Real (Block.Objects (1))); when others => Error_Msg_Exec ("unsupported foreign function call", Expr); end case; - return null; + return Res; end Execute_Foreign_Function_Call; -- BLOCK is the block instance in which the function call appears. diff --git a/src/vhdl/simulate/file_operation.adb b/src/vhdl/simulate/file_operation.adb index d5d141c53..dab6ec889 100644 --- a/src/vhdl/simulate/file_operation.adb +++ b/src/vhdl/simulate/file_operation.adb @@ -20,8 +20,8 @@ with Types; use Types; with Annotations; use Annotations; with Execution; use Execution; with Debugger; use Debugger; -with Grt.Types; use Grt.Types; with Grt_Interface; use Grt_Interface; +with Grt.Lib; package body File_Operation is -- Open a file. @@ -342,4 +342,43 @@ package body File_Operation is begin Ghdl_File_Flush (File.File); end Flush; + + procedure Textio_Write_Real (Str : Iir_Value_Literal_Acc; + Len : Iir_Value_Literal_Acc; + Val : Ghdl_F64; + Ndigits : Std_Integer) + is + Len_Arg : aliased Std_Integer; + Str_Len : constant Ghdl_Index_Type := + Ghdl_Index_Type (Str.Bounds.D (1).Length); + Str_Str : aliased Std_String_Uncons (1 .. Str_Len); + Str_Bnd : aliased Std_String_Bound := Build_Bound (Str); + Str_Arg : aliased Std_String := (To_Std_String_Basep (Str_Str'Address), + To_Std_String_Boundp (Str_Bnd'Address)); + begin + Grt.Lib.Textio_Write_Real + (Str_Arg'Unrestricted_Access, Len_Arg'Unrestricted_Access, + Val, Ndigits); + for I in 1 .. Len_Arg loop + Str.Val_Array.V (Iir_Index32 (I)).E8 := + Character'Pos (Str_Str (Ghdl_Index_Type (I))); + end loop; + Len.I64 := Ghdl_I64 (Len_Arg); + end Textio_Write_Real; + + function Textio_Read_Real (Str : Iir_Value_Literal_Acc) return Ghdl_F64 + is + Str_Len : constant Ghdl_Index_Type := + Ghdl_Index_Type (Str.Bounds.D (1).Length); + Str_Str : aliased Std_String_Uncons (1 .. Str_Len); + Str_Bnd : aliased Std_String_Bound := Build_Bound (Str); + Str_Arg : aliased Std_String := (To_Std_String_Basep (Str_Str'Address), + To_Std_String_Boundp (Str_Bnd'Address)); + begin + for I in Str.Val_Array.V'Range loop + Str_Str (Ghdl_Index_Type (I)) := + Character'Val (Str.Val_Array.V (I).E8); + end loop; + return Grt.Lib.Textio_Read_Real (Str_Arg'Unrestricted_Access); + end Textio_Read_Real; end File_Operation; diff --git a/src/vhdl/simulate/file_operation.ads b/src/vhdl/simulate/file_operation.ads index b66a06756..ea59f60d6 100644 --- a/src/vhdl/simulate/file_operation.ads +++ b/src/vhdl/simulate/file_operation.ads @@ -20,6 +20,7 @@ with Iirs; use Iirs; with Iir_Values; use Iir_Values; with Elaboration; use Elaboration; with Grt.Files; use Grt.Files; +with Grt.Types; use Grt.Types; package File_Operation is Null_File : constant Natural := 0; @@ -77,5 +78,13 @@ package File_Operation is -- Test end of FILE is reached. function Endfile (File : Iir_Value_Literal_Acc; Stmt : Iir) - return Boolean; + return Boolean; + + -- Fp to string + procedure Textio_Write_Real (Str : Iir_Value_Literal_Acc; + Len : Iir_Value_Literal_Acc; + Val : Ghdl_F64; + Ndigits : Std_Integer); + + function Textio_Read_Real (Str : Iir_Value_Literal_Acc) return Ghdl_F64; end File_Operation; diff --git a/src/vhdl/simulate/simulation.adb b/src/vhdl/simulate/simulation.adb index 26c5e9508..0b01a4c88 100644 --- a/src/vhdl/simulate/simulation.adb +++ b/src/vhdl/simulate/simulation.adb @@ -523,7 +523,8 @@ package body Simulation is Expr := Get_Timeout_Clause (Stmt); if Expr /= Null_Iir then Res := Execute_Expression (Instance, Expr); - Grt.Processes.Ghdl_Process_Wait_Set_Timeout (Std_Time (Res.I64)); + Grt.Processes.Ghdl_Process_Wait_Set_Timeout + (Std_Time (Res.I64), null, 0); end if; -- LRM93 8.1 |