diff options
-rw-r--r-- | doc/ghdl.texi | 5 | ||||
-rw-r--r-- | errorout.adb | 7 | ||||
-rw-r--r-- | ortho/gcc/ortho-lang.c | 9 | ||||
-rw-r--r-- | sem.adb | 15 | ||||
-rw-r--r-- | sem_decls.adb | 33 | ||||
-rw-r--r-- | sem_expr.adb | 2 | ||||
-rw-r--r-- | sem_names.adb | 2 | ||||
-rw-r--r-- | sem_types.adb | 19 | ||||
-rw-r--r-- | sem_types.ads | 5 | ||||
-rw-r--r-- | translate/gcc/INSTALL | 2 | ||||
-rwxr-xr-x | translate/gcc/dist.sh | 2 | ||||
-rw-r--r-- | translate/ghdldrv/ghdlrun.adb | 28 | ||||
-rw-r--r-- | translate/grt/grt-avhpi.adb | 7 | ||||
-rw-r--r-- | translate/grt/grt-disp_rti.adb | 8 | ||||
-rw-r--r-- | translate/grt/grt-files.adb | 4 | ||||
-rw-r--r-- | translate/grt/grt-images.adb | 7 | ||||
-rw-r--r-- | translate/grt/grt-images.ads | 3 | ||||
-rw-r--r-- | translate/grt/grt-rtis_addr.adb | 5 | ||||
-rw-r--r-- | translate/grt/grt-rtis_utils.adb | 16 | ||||
-rw-r--r-- | translate/grt/grt-signals.adb | 84 | ||||
-rw-r--r-- | translate/grt/grt-signals.ads | 34 | ||||
-rw-r--r-- | translate/trans_decls.ads | 10 | ||||
-rw-r--r-- | translate/translation.adb | 156 | ||||
-rw-r--r-- | version.ads | 2 |
24 files changed, 356 insertions, 109 deletions
diff --git a/doc/ghdl.texi b/doc/ghdl.texi index 62c2447ac..f4cfdf145 100644 --- a/doc/ghdl.texi +++ b/doc/ghdl.texi @@ -376,11 +376,12 @@ the ones of the previous examples. Let's see how to analyze and run a bigger design, such as the DLX model suite written by Peter Ashenden which is distributed under the terms of the -GNU General Public License. +GNU General Public License. A copy is kept on +@indicateurl{http://ghdl.free.fr/dlx.tar.gz} First, untar the sources: @smallexample -$ tar zxvf dlx.tar.Z +$ tar zxvf dlx.tar.gz @end smallexample In order not to pollute the sources with the library, it is a good idea diff --git a/errorout.adb b/errorout.adb index 66003b615..eed8b6f16 100644 --- a/errorout.adb +++ b/errorout.adb @@ -980,9 +980,12 @@ package body Errorout is Decl := Get_Type_Declarator (Def); if Decl /= Null_Iir then return Image_Identifier (Decl); - else - Decl := Get_Type_Declarator (Get_Base_Type (Def)); + end if; + Decl := Get_Type_Declarator (Get_Base_Type (Def)); + if Decl /= Null_Iir then return "a subtype of " & Image_Identifier (Decl); + else + return "an unknown type"; end if; end Disp_Type_Name; diff --git a/ortho/gcc/ortho-lang.c b/ortho/gcc/ortho-lang.c index b8cdfe605..5792f50d4 100644 --- a/ortho/gcc/ortho-lang.c +++ b/ortho/gcc/ortho-lang.c @@ -23,6 +23,8 @@ #include "tree-pass.h" #include "tree-dump.h" +static tree type_for_size (unsigned int precision, int unsignedp); + const int tree_identifier_size = sizeof (struct tree_identifier); struct binding_level GTY(()) @@ -250,13 +252,14 @@ ortho_init (void) push_binding (); build_common_tree_nodes (0, 0); + size_type_node = type_for_size (GET_MODE_BITSIZE (Pmode), 1); + set_sizetype (size_type_node); + build_common_tree_nodes_2 (0); + n = build_decl (TYPE_DECL, get_identifier ("int"), integer_type_node); push_decl (n); n = build_decl (TYPE_DECL, get_identifier ("char"), char_type_node); push_decl (n); - size_type_node = unsigned_type_node; - set_sizetype (unsigned_type_node); - build_common_tree_nodes_2 (0); /* Create alloca builtin. */ { @@ -1754,7 +1754,7 @@ package body Sem is when Iir_Kind_Sensitized_Process_Statement => Kind := K_Process; Subprg_Bod := Null_Iir; - Subprg_Depth := 0; + Subprg_Depth := Iir_Depth_Top; Depth := Iir_Depth_Impure; when others => Error_Kind ("update_and_check_pure_wait(1)", Subprg); @@ -1768,9 +1768,11 @@ package body Sem is for I in Natural loop Callee := Get_Nth_Element (Callees_List, I); exit when Callee = Null_Iir; + + -- Only procedures should appear in the list: + -- Pure functions should not be in the list. + -- Impure functions must have directly set Purity_State. if Get_Kind (Callee) /= Iir_Kind_Procedure_Declaration then - -- Pure functions should not be in the list. - -- Impure functions must have directly set Purity_State. Error_Kind ("update_and_check_pure_wait(3)", Callee); end if; @@ -1778,7 +1780,8 @@ package body Sem is Callee_Bod := Get_Subprogram_Body (Callee); if Callee_Bod = Null_Iir then -- No body yet for the subprogram called. - -- Nothing can be extracted from it, postpone the checks. + -- Nothing can be extracted from it, postpone the checks until + -- elaboration. Has_Unknown := True; else -- Second loop: recurse if a state is not known. @@ -1788,14 +1791,14 @@ package body Sem is Update_And_Check_Pure_Wait (Callee); end if; - -- Check purity only if the subprogram is not impure. if Depth /= Iir_Depth_Impure then Depth_Callee := Get_Impure_Depth (Callee_Bod); -- Check purity depth. if Depth_Callee < Subprg_Depth then - -- The call is an impure call. + -- The call is an impure call because it calls an outer + -- subprogram (or an impure subprogram). -- FIXME: check the compare. Depth_Callee := Iir_Depth_Impure; if Kind = K_Function then diff --git a/sem_decls.adb b/sem_decls.adb index a51d0faea..df5f6cf73 100644 --- a/sem_decls.adb +++ b/sem_decls.adb @@ -2156,37 +2156,6 @@ package body Sem_Decls is Set_Visible_Flag (Group, True); end Sem_Group_Declaration; - -- Return TRUE if FUNC can be a resolution function. - function Can_Be_Resolution_Function (Func : Iir_Function_Declaration) - return Boolean - is - Param : Iir; - Param_Type : Iir; - Res_Type : Iir; - begin - Param := Get_Interface_Declaration_Chain (Func); - - -- Return now if the number of parameters is not 1. - if Param = Null_Iir or else Get_Chain (Param) /= Null_Iir then - return False; - end if; - Param_Type := Get_Type (Param); - case Get_Kind (Param_Type) is - when Iir_Kind_Array_Type_Definition - | Iir_Kind_Unconstrained_Array_Subtype_Definition => - null; - when others => - return False; - end case; - Res_Type := Get_Return_Type (Func); - if Get_Base_Type (Get_Element_Subtype (Param_Type)) - /= Get_Base_Type (Res_Type) - then - return False; - end if; - return True; - end Can_Be_Resolution_Function; - -- Semantize every declaration of DECLS_PARENT. -- STMTS is the concurrent statement list associated with DECLS_PARENT -- if any, or null_iir. This is used for specification. @@ -2247,7 +2216,7 @@ package body Sem_Decls is end if; if Is_Global and then Kind = Iir_Kind_Function_Declaration - and then Can_Be_Resolution_Function (Res) + and then Is_A_Resolution_Function (Res, Null_Iir) then Set_Resolution_Function_Flag (Res, True); end if; diff --git a/sem_expr.adb b/sem_expr.adb index a0ec9b76f..43be15a37 100644 --- a/sem_expr.adb +++ b/sem_expr.adb @@ -3767,7 +3767,7 @@ package body Sem_Expr is if Res /= Null_Iir and then Is_Overloaded (Res) then Error_Overload (Expr); - Disp_Overload_List (Get_Overload_List (Res), Expr); + Disp_Overload_List (Get_Overload_List (Get_Type (Res)), Expr); return Null_Iir; end if; return Res; diff --git a/sem_names.adb b/sem_names.adb index 4a01133c2..ff0c8795c 100644 --- a/sem_names.adb +++ b/sem_names.adb @@ -1973,7 +1973,7 @@ package body Sem_Names is when Iir_Kinds_Procedure_Declaration => Error_Msg_Sem ("function name is a procedure", Name); - when Iir_Kind_Process_Statement + when Iir_Kinds_Process_Statement | Iir_Kind_Component_Declaration | Iir_Kind_Type_Conversion => Error_Msg_Sem diff --git a/sem_types.adb b/sem_types.adb index bb946a5c0..9b35cc660 100644 --- a/sem_types.adb +++ b/sem_types.adb @@ -997,6 +997,7 @@ package body Sem_Types is is Decl: Iir; Decl_Type : Iir; + Ret_Type : Iir; begin -- LRM93 2.4 -- A resolution function must be a [pure] function; @@ -1023,22 +1024,26 @@ package body Sem_Types is end if; -- LRM93 2.4 -- whose element type is that of the resolved signal. + -- The type of the return value of the function must also be that of + -- the signal. + Ret_Type := Get_Return_Type (Func); if Get_Base_Type (Get_Element_Subtype (Decl_Type)) - /= Get_Base_Type (Atype) + /= Get_Base_Type (Ret_Type) then return False; end if; - -- LRM93 2.4 - -- The type of the return value of the function must also be that of - -- the signal. - if Get_Base_Type (Get_Return_Type (Func)) /= Get_Base_Type (Atype) then + if Atype /= Null_Iir + and then Get_Base_Type (Ret_Type) /= Get_Base_Type (Atype) + then return False; end if; -- LRM93 2.4 -- A resolution function must be a [pure] function; if Flags.Vhdl_Std >= Vhdl_93 and then Get_Pure_Flag (Func) = False then - Error_Msg_Sem - ("resolution " & Disp_Node (Func) & " must be pure", Atype); + if Atype /= Null_Iir then + Error_Msg_Sem + ("resolution " & Disp_Node (Func) & " must be pure", Atype); + end if; return False; end if; return True; diff --git a/sem_types.ads b/sem_types.ads index 6df559df2..a51379477 100644 --- a/sem_types.ads +++ b/sem_types.ads @@ -45,4 +45,9 @@ package Sem_Types is -- If ATYPE can have signal (eg: access or file type), then this procedure -- returns silently. procedure Set_Type_Has_Signal (Atype : Iir); + + -- Return TRUE iff FUNC is a resolution function. + -- If ATYPE is not NULL_IIR, type must match. + function Is_A_Resolution_Function (Func: Iir; Atype: Iir) return Boolean; + end Sem_Types; diff --git a/translate/gcc/INSTALL b/translate/gcc/INSTALL index 2f5c5e13b..26b0ee3cd 100644 --- a/translate/gcc/INSTALL +++ b/translate/gcc/INSTALL @@ -13,7 +13,7 @@ You must be root to install this distribution. To install ghdl: $ su -# tar -C / -zxvf @TARFILE@ +# tar -C / -jxvf @TARFILE@.tar.bz2 Note: you must also have a C compiler and zlib installed. diff --git a/translate/gcc/dist.sh b/translate/gcc/dist.sh index 65aa92033..e03e686ed 100755 --- a/translate/gcc/dist.sh +++ b/translate/gcc/dist.sh @@ -230,7 +230,7 @@ do_tar_dist () { rm -rf $bindirname mkdir $bindirname - sed -e "s/@TARFILE@/$dir.tar/" < INSTALL > $bindirname/INSTALL + sed -e "s/@TARFILE@/$bindirname/" < INSTALL > $bindirname/INSTALL ln ../../COPYING $bindirname ln $TARINSTALL $bindirname tar cvf $bindirname.tar $bindirname diff --git a/translate/ghdldrv/ghdlrun.adb b/translate/ghdldrv/ghdlrun.adb index 0dc31f40f..1d70c141b 100644 --- a/translate/ghdldrv/ghdlrun.adb +++ b/translate/ghdldrv/ghdlrun.adb @@ -352,6 +352,8 @@ package body Ghdlrun is Grt.Signals.Ghdl_Signal_Driving_Value_B2'Address); Def (Trans_Decls.Ghdl_Signal_Driving_Value_E8, Grt.Signals.Ghdl_Signal_Driving_Value_E8'Address); + Def (Trans_Decls.Ghdl_Signal_Driving_Value_E32, + Grt.Signals.Ghdl_Signal_Driving_Value_E32'Address); Def (Trans_Decls.Ghdl_Signal_Driving_Value_I32, Grt.Signals.Ghdl_Signal_Driving_Value_I32'Address); Def (Trans_Decls.Ghdl_Signal_Driving_Value_I64, @@ -398,6 +400,19 @@ package body Ghdlrun is Def (Trans_Decls.Ghdl_Signal_Associate_E8, Grt.Signals.Ghdl_Signal_Associate_E8'Address); + Def (Trans_Decls.Ghdl_Create_Signal_E32, + Grt.Signals.Ghdl_Create_Signal_E32'Address); + Def (Trans_Decls.Ghdl_Signal_Init_E32, + Grt.Signals.Ghdl_Signal_Init_E32'Address); + Def (Trans_Decls.Ghdl_Signal_Simple_Assign_E32, + Grt.Signals.Ghdl_Signal_Simple_Assign_E32'Address); + Def (Trans_Decls.Ghdl_Signal_Start_Assign_E32, + Grt.Signals.Ghdl_Signal_Start_Assign_E32'Address); + Def (Trans_Decls.Ghdl_Signal_Next_Assign_E32, + Grt.Signals.Ghdl_Signal_Next_Assign_E32'Address); + Def (Trans_Decls.Ghdl_Signal_Associate_E32, + Grt.Signals.Ghdl_Signal_Associate_E32'Address); + Def (Trans_Decls.Ghdl_Create_Signal_I32, Grt.Signals.Ghdl_Create_Signal_I32'Address); Def (Trans_Decls.Ghdl_Signal_Init_I32, @@ -479,18 +494,25 @@ package body Ghdlrun is Grt.Files.Ghdl_Text_File_Finalize'Address); Def (Trans_Decls.Ghdl_Text_File_Open, Grt.Files.Ghdl_Text_File_Open'Address); + Def (Trans_Decls.Ghdl_Text_File_Open_Status, + Grt.Files.Ghdl_Text_File_Open_Status'Address); Def (Trans_Decls.Ghdl_Text_Write, Grt.Files.Ghdl_Text_Write'Address); Def (Trans_Decls.Ghdl_Text_Read_Length, Grt.Files.Ghdl_Text_Read_Length'Address); Def (Trans_Decls.Ghdl_Text_File_Close, Grt.Files.Ghdl_Text_File_Close'Address); - Def (Trans_Decls.Ghdl_File_Close, - Grt.Files.Ghdl_File_Close'Address); + Def (Trans_Decls.Ghdl_File_Elaborate, Grt.Files.Ghdl_File_Elaborate'Address); + Def (Trans_Decls.Ghdl_File_Finalize, + Grt.Files.Ghdl_File_Finalize'Address); Def (Trans_Decls.Ghdl_File_Open, Grt.Files.Ghdl_File_Open'Address); + Def (Trans_Decls.Ghdl_File_Open_Status, + Grt.Files.Ghdl_File_Open_Status'Address); + Def (Trans_Decls.Ghdl_File_Close, + Grt.Files.Ghdl_File_Close'Address); Def (Trans_Decls.Ghdl_Write_Scalar, Grt.Files.Ghdl_Write_Scalar'Address); Def (Trans_Decls.Ghdl_Read_Scalar, @@ -503,6 +525,8 @@ package body Ghdlrun is Grt.Images.Ghdl_Image_B2'Address); Def (Trans_Decls.Ghdl_Image_E8, Grt.Images.Ghdl_Image_E8'Address); + Def (Trans_Decls.Ghdl_Image_E32, + Grt.Images.Ghdl_Image_E32'Address); Def (Trans_Decls.Ghdl_Image_I32, Grt.Images.Ghdl_Image_I32'Address); Def (Trans_Decls.Ghdl_Image_F64, diff --git a/translate/grt/grt-avhpi.adb b/translate/grt/grt-avhpi.adb index fc38f8792..7c8b10f5a 100644 --- a/translate/grt/grt-avhpi.adb +++ b/translate/grt/grt-avhpi.adb @@ -329,7 +329,8 @@ package body Grt.Avhpi is end if; end; when Ghdl_Rtik_Type_B2 - | Ghdl_Rtik_Type_E8 => + | Ghdl_Rtik_Type_E8 + | Ghdl_Rtik_Type_E32 => Res := (Kind => VhpiEnumTypeDeclK, Ctxt => Ctxt, Atype => Rti); @@ -387,6 +388,7 @@ package body Grt.Avhpi is | Ghdl_Rtik_Subtype_Array | Ghdl_Rtik_Subtype_Array_Ptr | Ghdl_Rtik_Type_E8 + | Ghdl_Rtik_Type_E32 | Ghdl_Rtik_Type_B2 => Rti_To_Handle (Ch, Iterator.Ctxt, Res); if Res.Kind /= VhpiUndefined then @@ -581,6 +583,9 @@ package body Grt.Avhpi is -- when Ghdl_Rtik_Type_E8 => -- Disp_Enum_Value -- (Stream, Rti, Ghdl_Index_Type (Vptr.E8)); +-- when Ghdl_Rtik_Type_E32 => +-- Disp_Enum_Value +-- (Stream, Rti, Ghdl_Index_Type (Vptr.E32)); -- when Ghdl_Rtik_Type_B2 => -- Disp_Enum_Value -- (Stream, Rti, diff --git a/translate/grt/grt-disp_rti.adb b/translate/grt/grt-disp_rti.adb index e9ac3e60d..dded64430 100644 --- a/translate/grt/grt-disp_rti.adb +++ b/translate/grt/grt-disp_rti.adb @@ -73,6 +73,11 @@ package body Grt.Disp_Rti is if not Is_Sig then Update (8); end if; + when Ghdl_Rtik_Type_E32 => + Disp_Enum_Value (Stream, Rti, Ghdl_Index_Type (Vptr.E32)); + if not Is_Sig then + Update (32); + end if; when Ghdl_Rtik_Type_B2 => Disp_Enum_Value (Stream, Rti, Ghdl_Index_Type (Ghdl_B2'Pos (Vptr.B2))); @@ -201,6 +206,7 @@ package body Grt.Disp_Rti is Obj, Is_Sig); when Ghdl_Rtik_Type_I32 | Ghdl_Rtik_Type_E8 + | Ghdl_Rtik_Type_E32 | Ghdl_Rtik_Type_B2 => Disp_Scalar_Value (Stream, Rti, Obj, Is_Sig); when Ghdl_Rtik_Type_Array => @@ -310,6 +316,8 @@ package body Grt.Disp_Rti is Put ("ghdl_rtik_type_b2"); when Ghdl_Rtik_Type_E8 => Put ("ghdl_rtik_type_e8"); + when Ghdl_Rtik_Type_E32 => + Put ("ghdl_rtik_type_e32"); when Ghdl_Rtik_Type_P64 => Put ("ghdl_rtik_type_p64"); when Ghdl_Rtik_Type_I32 => diff --git a/translate/grt/grt-files.adb b/translate/grt/grt-files.adb index 974d5578b..9037fcebe 100644 --- a/translate/grt/grt-files.adb +++ b/translate/grt/grt-files.adb @@ -153,8 +153,8 @@ package body Grt.Files is end if; -- Copy file name and convert it to a C string (NUL terminated). - for I in 0 .. Str.Bounds.Dim_1.Length - 1 loop - Name (1 + Natural (I)) := Str.Base (I); + for I in 1 .. Str.Bounds.Dim_1.Length loop + Name (Natural (I)) := Str.Base (I - 1); end loop; Name (Name'Last) := NUL; diff --git a/translate/grt/grt-images.adb b/translate/grt/grt-images.adb index 396a0eade..5f8a081f9 100644 --- a/translate/grt/grt-images.adb +++ b/translate/grt/grt-images.adb @@ -68,6 +68,13 @@ package body Grt.Images is Return_Enum (Res, Rti, Ghdl_E8'Pos (Val)); end Ghdl_Image_E8; + procedure Ghdl_Image_E32 + (Res : Std_String_Ptr; Val : Ghdl_E32; Rti : Ghdl_Rti_Access) + is + begin + Return_Enum (Res, Rti, Ghdl_E32'Pos (Val)); + end Ghdl_Image_E32; + procedure Ghdl_Image_I32 (Res : Std_String_Ptr; Val : Ghdl_I32) is Str : String (1 .. 11); diff --git a/translate/grt/grt-images.ads b/translate/grt/grt-images.ads index fb33b6376..74a7bd7e9 100644 --- a/translate/grt/grt-images.ads +++ b/translate/grt/grt-images.ads @@ -23,6 +23,8 @@ package Grt.Images is (Res : Std_String_Ptr; Val : Ghdl_B2; Rti : Ghdl_Rti_Access); procedure Ghdl_Image_E8 (Res : Std_String_Ptr; Val : Ghdl_E8; Rti : Ghdl_Rti_Access); + procedure Ghdl_Image_E32 + (Res : Std_String_Ptr; Val : Ghdl_E32; Rti : Ghdl_Rti_Access); procedure Ghdl_Image_I32 (Res : Std_String_Ptr; Val : Ghdl_I32); procedure Ghdl_Image_F64 (Res : Std_String_Ptr; Val : Ghdl_F64); procedure Ghdl_Image_P64 @@ -32,6 +34,7 @@ package Grt.Images is private pragma Export (C, Ghdl_Image_B2, "__ghdl_image_b2"); pragma Export (C, Ghdl_Image_E8, "__ghdl_image_e8"); + pragma Export (C, Ghdl_Image_E32, "__ghdl_image_e32"); pragma Export (C, Ghdl_Image_I32, "__ghdl_image_i32"); pragma Export (C, Ghdl_Image_F64, "__ghdl_image_f64"); pragma Export (C, Ghdl_Image_P64, "__ghdl_image_p64"); diff --git a/translate/grt/grt-rtis_addr.adb b/translate/grt/grt-rtis_addr.adb index 4f24fe776..64273b3f3 100644 --- a/translate/grt/grt-rtis_addr.adb +++ b/translate/grt/grt-rtis_addr.adb @@ -231,6 +231,10 @@ package body Grt.Rtis_Addr is Align (Ghdl_Range_E8'Alignment); Res (I) := To_Ghdl_Range_Ptr (Bounds); Update (Ghdl_Range_E8'Size); + when Ghdl_Rtik_Type_E32 => + Align (Ghdl_Range_E32'Alignment); + Res (I) := To_Ghdl_Range_Ptr (Bounds); + Update (Ghdl_Range_E32'Size); when others => -- Bounds are not known anymore. Bounds := Null_Address; @@ -249,6 +253,7 @@ package body Grt.Rtis_Addr is return To_Ghdl_Rti_Access (To_Ghdl_Rtin_Subtype_Array_Acc (Atype).Basetype); when Ghdl_Rtik_Type_E8 + | Ghdl_Rtik_Type_E32 | Ghdl_Rtik_Type_B2 => return Atype; when others => diff --git a/translate/grt/grt-rtis_utils.adb b/translate/grt/grt-rtis_utils.adb index 9754adac8..4fd558e3d 100644 --- a/translate/grt/grt-rtis_utils.adb +++ b/translate/grt/grt-rtis_utils.adb @@ -198,6 +198,8 @@ package body Grt.Rtis_Utils is Update (32); when Ghdl_Rtik_Type_E8 => Update (8); + when Ghdl_Rtik_Type_E32 => + Update (32); when Ghdl_Rtik_Type_B2 => Update (8); when Ghdl_Rtik_Type_F64 => @@ -231,6 +233,13 @@ package body Grt.Rtis_Utils is when Dir_Downto => Val.E8 := Rng.E8.Left - Ghdl_E8 (Pos); end case; + when Ghdl_Rtik_Type_E32 => + case Rng.E32.Dir is + when Dir_To => + Val.E32 := Rng.E32.Left + Ghdl_E32 (Pos); + when Dir_Downto => + Val.E32 := Rng.E32.Left - Ghdl_E32 (Pos); + end case; when Ghdl_Rtik_Type_B2 => case Pos is when 0 => @@ -265,6 +274,8 @@ package body Grt.Rtis_Utils is end; when Ghdl_Rtik_Type_E8 => Get_Enum_Value (Vstr, Rti, Ghdl_Index_Type (V.E8)); + when Ghdl_Rtik_Type_E32 => + Get_Enum_Value (Vstr, Rti, Ghdl_Index_Type (V.E32)); when Ghdl_Rtik_Type_B2 => Get_Enum_Value (Vstr, Rti, Ghdl_B2'Pos (V.B2)); when others => @@ -348,6 +359,7 @@ package body Grt.Rtis_Utils is Handle_Scalar (To_Ghdl_Rtin_Subtype_Scalar_Acc (Rti).Basetype); when Ghdl_Rtik_Type_I32 | Ghdl_Rtik_Type_E8 + | Ghdl_Rtik_Type_E32 | Ghdl_Rtik_Type_B2 => Handle_Scalar (Rti); when Ghdl_Rtik_Type_Array => @@ -430,6 +442,8 @@ package body Grt.Rtis_Utils is end; when Ghdl_Rtik_Type_E8 => Get_Enum_Value (Str, Type_Rti, Ghdl_Index_Type (Value.E8)); + when Ghdl_Rtik_Type_E32 => + Get_Enum_Value (Str, Type_Rti, Ghdl_Index_Type (Value.E32)); when Ghdl_Rtik_Type_B2 => Get_Enum_Value (Str, Type_Rti, Ghdl_Index_Type (Ghdl_B2'Pos (Value.B2))); @@ -520,6 +534,8 @@ package body Grt.Rtis_Utils is end; when Ghdl_Rtik_Type_E8 => Get_Enum_Value (Rstr, Type_Rti, Ghdl_Index_Type (Value.E8)); + when Ghdl_Rtik_Type_E32 => + Get_Enum_Value (Rstr, Type_Rti, Ghdl_Index_Type (Value.E32)); when Ghdl_Rtik_Type_B2 => Get_Enum_Value (Rstr, Type_Rti, Ghdl_Index_Type (Ghdl_B2'Pos (Value.B2))); diff --git a/translate/grt/grt-signals.adb b/translate/grt/grt-signals.adb index 5b3a12f94..a165144f4 100644 --- a/translate/grt/grt-signals.adb +++ b/translate/grt/grt-signals.adb @@ -802,6 +802,77 @@ package body Grt.Signals is (Sign, Value_Union'(Mode => Mode_E8, E8 => Val), After); end Ghdl_Signal_Next_Assign_E8; + function Ghdl_Create_Signal_E32 + (Init_Val : Ghdl_E32; + Resolv_Func : System.Address; + Resolv_Inst : System.Address) + return Ghdl_Signal_Ptr + is + begin + return Create_Signal + (Mode_E32, Value_Union'(Mode => Mode_E32, E32 => Init_Val), + Get_Current_Mode_Signal, + Resolv_Func, Resolv_Inst); + end Ghdl_Create_Signal_E32; + + procedure Ghdl_Signal_Init_E32 (Sig : Ghdl_Signal_Ptr; Init_Val : Ghdl_E32) + is + begin + Ghdl_Signal_Init (Sig, Value_Union'(Mode => Mode_E32, E32 => Init_Val)); + end Ghdl_Signal_Init_E32; + + procedure Ghdl_Signal_Associate_E32 (Sig : Ghdl_Signal_Ptr; Val : Ghdl_E32) + is + begin + Ghdl_Signal_Associate (Sig, Value_Union'(Mode => Mode_E32, E32 => Val)); + end Ghdl_Signal_Associate_E32; + + procedure Ghdl_Signal_Simple_Assign_E32 (Sign : Ghdl_Signal_Ptr; + Val : Ghdl_E32) + is + Trans : Transaction_Acc; + begin + if not Sign.Flags.Has_Active + and then Sign.Net = Net_One_Driver + and then Val = Sign.Value.E32 + and then Sign.S.Drivers (0).First_Trans.Next = null + then + return; + end if; + + Trans := new Transaction' + (Kind => Trans_Value, + Time => 0, + Next => null, + Val => Value_Union'(Mode => Mode_E32, E32 => Val)); + + Ghdl_Signal_Start_Assign (Sign, 0, Trans, 0); + end Ghdl_Signal_Simple_Assign_E32; + + procedure Ghdl_Signal_Start_Assign_E32 (Sign : Ghdl_Signal_Ptr; + Rej : Std_Time; + Val : Ghdl_E32; + After : Std_Time) + is + Trans : Transaction_Acc; + begin + Trans := new Transaction' + (Kind => Trans_Value, + Time => 0, + Next => null, + Val => Value_Union'(Mode => Mode_E32, E32 => Val)); + Ghdl_Signal_Start_Assign (Sign, Rej, Trans, After); + end Ghdl_Signal_Start_Assign_E32; + + procedure Ghdl_Signal_Next_Assign_E32 (Sign : Ghdl_Signal_Ptr; + Val : Ghdl_E32; + After : Std_Time) + is + begin + Ghdl_Signal_Next_Assign + (Sign, Value_Union'(Mode => Mode_E32, E32 => Val), After); + end Ghdl_Signal_Next_Assign_E32; + function Ghdl_Create_Signal_I32 (Init_Val : Ghdl_I32; Resolv_Func : System.Address; @@ -1358,6 +1429,19 @@ package body Grt.Signals is end if; end Ghdl_Signal_Driving_Value_E8; + function Ghdl_Signal_Driving_Value_E32 (Sig : Ghdl_Signal_Ptr) + return Ghdl_E32 + is + Drv : Driver_Acc; + begin + Drv := Get_Driver (Sig); + 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.E32; + end if; + end Ghdl_Signal_Driving_Value_E32; + function Ghdl_Signal_Driving_Value_I32 (Sig : Ghdl_Signal_Ptr) return Ghdl_I32 is diff --git a/translate/grt/grt-signals.ads b/translate/grt/grt-signals.ads index c78bf52f2..500cd55a0 100644 --- a/translate/grt/grt-signals.ads +++ b/translate/grt/grt-signals.ads @@ -453,6 +453,25 @@ 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; + 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; + Val : Ghdl_E32); + procedure Ghdl_Signal_Start_Assign_E32 (Sign : Ghdl_Signal_Ptr; + Rej : Std_Time; + Val : Ghdl_E32; + After : Std_Time); + procedure Ghdl_Signal_Next_Assign_E32 (Sign : Ghdl_Signal_Ptr; + Val : Ghdl_E32; + After : Std_Time); + 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; @@ -634,6 +653,21 @@ private pragma Export (C, Ghdl_Signal_Driving_Value_E8, "__ghdl_signal_driving_value_e8"); + pragma Export (C, Ghdl_Create_Signal_E32, + "__ghdl_create_signal_e32"); + pragma Export (C, Ghdl_Signal_Init_E32, + "__ghdl_signal_init_e32"); + pragma Export (C, Ghdl_Signal_Associate_E32, + "__ghdl_signal_associate_e32"); + pragma Export (C, Ghdl_Signal_Simple_Assign_E32, + "__ghdl_signal_simple_assign_e32"); + pragma Export (C, Ghdl_Signal_Start_Assign_E32, + "__ghdl_signal_start_assign_e32"); + pragma Export (C, Ghdl_Signal_Next_Assign_E32, + "__ghdl_signal_next_assign_e32"); + pragma Export (C, Ghdl_Signal_Driving_Value_E32, + "__ghdl_signal_driving_value_e32"); + pragma Export (C, Ghdl_Create_Signal_I32, "__ghdl_create_signal_i32"); pragma Export (C, Ghdl_Signal_Init_I32, diff --git a/translate/trans_decls.ads b/translate/trans_decls.ads index 20498e4df..6141fcd5b 100644 --- a/translate/trans_decls.ads +++ b/translate/trans_decls.ads @@ -77,6 +77,14 @@ package Trans_Decls is Ghdl_Signal_Associate_E8 : O_Dnode; Ghdl_Signal_Driving_Value_E8 : O_Dnode; + Ghdl_Create_Signal_E32 : O_Dnode; + Ghdl_Signal_Init_E32 : O_Dnode; + Ghdl_Signal_Simple_Assign_E32 : O_Dnode; + Ghdl_Signal_Start_Assign_E32 : O_Dnode; + Ghdl_Signal_Next_Assign_E32 : O_Dnode; + Ghdl_Signal_Associate_E32 : O_Dnode; + Ghdl_Signal_Driving_Value_E32 : O_Dnode; + Ghdl_Create_Signal_B2 : O_Dnode; Ghdl_Signal_Init_B2 : O_Dnode; Ghdl_Signal_Simple_Assign_B2 : O_Dnode; @@ -190,6 +198,7 @@ package Trans_Decls is -- 'Image attributes. Ghdl_Image_B2 : O_Dnode; Ghdl_Image_E8 : O_Dnode; + Ghdl_Image_E32 : O_Dnode; Ghdl_Image_I32 : O_Dnode; Ghdl_Image_P32 : O_Dnode; Ghdl_Image_P64 : O_Dnode; @@ -198,6 +207,7 @@ package Trans_Decls is -- 'Value attributes Ghdl_Value_B2 : O_Dnode; Ghdl_Value_E8 : O_Dnode; + Ghdl_Value_E32 : O_Dnode; Ghdl_Value_I32 : O_Dnode; Ghdl_Value_P32 : O_Dnode; Ghdl_Value_P64 : O_Dnode; diff --git a/translate/translation.adb b/translate/translation.adb index dfbe23a06..9241f366c 100644 --- a/translate/translation.adb +++ b/translate/translation.adb @@ -978,8 +978,12 @@ package body Translation is Resolv_Block : Iir; -- Parameter nodes. Var_Instance : O_Dnode; + + -- Signals Var_Vals : O_Dnode; + -- Driving vector. Var_Vec : O_Dnode; + -- Length of Vector. Var_Vlen : O_Dnode; Var_Nbr_Drv : O_Dnode; Var_Nbr_Ports : O_Dnode; @@ -6659,7 +6663,10 @@ package body Translation is case Get_Kind (El) is when Iir_Kind_Function_Declaration | Iir_Kind_Procedure_Declaration => - Chap2.Translate_Subprogram_Declaration (El); + -- Translate only if used. + if Get_Info (El) /= null then + Chap2.Translate_Subprogram_Declaration (El); + end if; when others => Error_Kind ("translate_protected_type_subprograms", El); end case; @@ -8128,10 +8135,11 @@ package body Translation is end; when Type_Mode_Fat_Array => -- a fat array. + D := Stabilize (Dest); Gen_Memcpy - (M2Addr (Get_Array_Base (Dest)), + (M2Addr (Get_Array_Base (D)), M2Addr (Get_Array_Base (E2M (Src, Info, Kind))), - Get_Object_Size (Dest, Obj_Type)); + Get_Object_Size (D, Obj_Type)); when Type_Mode_Record | Type_Mode_Ptr_Array => Gen_Memcpy @@ -9427,6 +9435,9 @@ package body Translation is when Type_Mode_E8 => Create_Subprg := Ghdl_Create_Signal_E8; Conv := Ghdl_I32_Type; + when Type_Mode_E32 => + Create_Subprg := Ghdl_Create_Signal_E32; + Conv := Ghdl_I32_Type; when Type_Mode_I32 | Type_Mode_P32 => Create_Subprg := Ghdl_Create_Signal_I32; @@ -10254,7 +10265,8 @@ package body Translation is (Interface_List, Rinfo.Var_Instance, Wki_Instance, Itype); -- The signal. - El_Type := Get_Return_Type (Func); + El_Type := Get_Type (Get_Interface_Declaration_Chain (Func)); + El_Type := Get_Element_Subtype (El_Type); El_Info := Get_Info (El_Type); case El_Info.Type_Mode is when Type_Mode_Thin => @@ -10383,10 +10395,17 @@ package body Translation is is -- Type of the resolution function parameter. Arr_Type : Iir; - Base_Type, El_Type : Iir; - El_Info : Type_Info_Acc; + Base_Type : Iir; Base_Info : Type_Info_Acc; + -- Type of parameter element. + El_Type : Iir; + El_Info : Type_Info_Acc; + + -- Type of the function return value. + Ret_Type : Iir; + Ret_Info : Type_Info_Acc; + -- Type and info of the array index. Index_Type : Iir; Index_Tinfo : Type_Info_Acc; @@ -10421,13 +10440,16 @@ package body Translation is return; end if; - El_Type := Get_Return_Type (Func); - El_Info := Get_Info (El_Type); + Ret_Type := Get_Return_Type (Func); + Ret_Info := Get_Info (Ret_Type); Arr_Type := Get_Type (Get_Interface_Declaration_Chain (Func)); Base_Type := Get_Base_Type (Arr_Type); Base_Info := Get_Info (Base_Type); + El_Type := Get_Element_Subtype (Arr_Type); + El_Info := Get_Info (El_Type); + Index_Type := Get_First_Element (Get_Index_Subtype_List (Arr_Type)); Index_Tinfo := Get_Info (Index_Type); @@ -10441,7 +10463,7 @@ package body Translation is -- A signal. New_Var_Decl (Var_Res, Get_Identifier ("res"), - O_Storage_Local, El_Info.Ortho_Type (Mode_Value)); + O_Storage_Local, Ret_Info.Ortho_Type (Mode_Value)); -- I, J. New_Var_Decl (Var_I, Wki_I, O_Storage_Local, Ghdl_Index_Type); @@ -10559,8 +10581,10 @@ package body Translation is Finish_Loop_Stmt (Label); if Finfo.Res_Interface /= O_Dnode_Null then - Res := Lo2M (Var_Res, El_Info, Mode_Value); - Allocate_Complex_Object (El_Type, Alloc_Stack, Res); + Res := Lo2M (Var_Res, Ret_Info, Mode_Value); + if Ret_Info.Type_Mode /= Type_Mode_Fat_Array then + Allocate_Complex_Object (Ret_Type, Alloc_Stack, Res); + end if; end if; -- Call the resolution function. @@ -10574,11 +10598,17 @@ package body Translation is Base_Info.Ortho_Ptr_Type (Mode_Value))); if Finfo.Res_Interface = O_Dnode_Null then - Res := E2M (New_Function_Call (Assoc), El_Info, Mode_Value); + Res := E2M (New_Function_Call (Assoc), Ret_Info, Mode_Value); else New_Procedure_Call (Assoc); end if; + if El_Type /= Ret_Type then + Res := E2M + (Chap7.Translate_Implicit_Conv (M2E (Res), Ret_Type, El_Type, + Mode_Value, Func), + El_Info, Mode_Value); + end if; Chap7.Set_Driving_Value (Vals, El_Type, Res); Close_Temp; @@ -10600,11 +10630,7 @@ package body Translation is when Iir_Kind_Procedure_Declaration | Iir_Kind_Function_Declaration => -- Translate interfaces. - if Flag_Discard_Unused - and then not Get_Use_Flag (El) - then - null; - else + if not Flag_Discard_Unused or else Get_Use_Flag (El) then Info := Add_Info (El, Kind_Subprg); Chap2.Translate_Subprogram_Interfaces (El); if Get_Kind (El) = Iir_Kind_Function_Declaration @@ -10637,18 +10663,16 @@ package body Translation is case Get_Kind (El) is when Iir_Kind_Procedure_Declaration | Iir_Kind_Function_Declaration => + -- Translate only if used. if Get_Info (El) /= null then Chap2.Translate_Subprogram_Declaration (El); Translate_Resolution_Function (El, Block); end if; when Iir_Kind_Function_Body | Iir_Kind_Procedure_Body => - if Flag_Discard_Unused - and then - not Get_Use_Flag (Get_Subprogram_Specification (El)) + if not Flag_Discard_Unused + or else Get_Use_Flag (Get_Subprogram_Specification (El)) then - null; - else Chap2.Translate_Subprogram_Body (El); Translate_Resolution_Function_Body (Get_Subprogram_Specification (El), Block); @@ -11455,6 +11479,9 @@ package body Translation is when Type_Mode_E8 => Subprg := Ghdl_Signal_Associate_E8; Conv := Ghdl_I32_Type; + when Type_Mode_E32 => + Subprg := Ghdl_Signal_Associate_E32; + Conv := Ghdl_I32_Type; when Type_Mode_I32 => Subprg := Ghdl_Signal_Associate_I32; Conv := Ghdl_I32_Type; @@ -14918,8 +14945,6 @@ package body Translation is begin Tinfo := Get_Info (Target_Type); Open_Temp; - -- FIXME: to be removed ? - --Chap3.Translate_Type_Definition (Aggr_Type); Targ := Stabilize (Target); Base := Stabilize (Chap3.Get_Array_Base (Targ)); Bounds := Stabilize (Chap3.Get_Array_Bounds (Targ)); @@ -15053,6 +15078,10 @@ package body Translation is Translate_Array_Aggregate_Gen (Base, Bounds, Aggr, Aggr_Type, 1, Var_Index); Close_Temp; + + -- FIXME: creating aggregate subtype is expensive and rarely used. + -- (one of the current use - only ? - is check_array_match). + Chap3.Translate_Type_Definition (Aggr_Type, False); end Translate_Array_Aggregate; procedure Translate_Aggregate @@ -15174,7 +15203,8 @@ package body Translation is Res_Info := Get_Info (Res_Type); Expr_Info := Get_Info (Expr_Type); case Res_Info.Type_Mode is - when Type_Mode_Array => + when Type_Mode_Array + | Type_Mode_Ptr_Array => declare E : O_Dnode; begin @@ -15612,9 +15642,6 @@ package body Translation is | Iir_Kind_Simple_Aggregate | Iir_Kind_Simple_Name_Attribute => Res := Translate_String_Literal (Expr); - Res := Translate_Implicit_Conv - (Res, Expr_Type, Res_Type, Mode_Value, Expr); - return Res; when Iir_Kind_Aggregate => declare @@ -15700,8 +15727,6 @@ package body Translation is when Iir_Kind_Qualified_Expression => -- FIXME: check type. Res := Translate_Expression (Get_Expression (Expr), Expr_Type); - return Translate_Implicit_Conv - (Res, Expr_Type, Rtype, Mode_Value, Expr); when Iir_Kind_Constant_Declaration | Iir_Kind_Variable_Declaration @@ -15735,11 +15760,6 @@ package body Translation is Res := Translate_Signal (Res, Expr_Type); end if; end; - if Rtype /= Null_Iir then - Res := Translate_Implicit_Conv - (Res, Expr_Type, Rtype, Mode_Value, Expr); - end if; - return Res; when Iir_Kind_Iterator_Declaration => declare @@ -15802,9 +15822,7 @@ package body Translation is Assoc_Chain := Canon.Canon_Subprogram_Call (Expr); Res := Translate_Function_Call (Imp, Assoc_Chain, Get_Method_Object (Expr)); - return Translate_Implicit_Conv - (Res, Get_Return_Type (Imp), - Res_Type, Mode_Value, Expr); + Expr_Type := Get_Return_Type (Imp); end if; end; @@ -15816,8 +15834,6 @@ package body Translation is Res := Translate_Type_Conversion (Translate_Expression (Conv_Expr), Get_Type (Conv_Expr), Expr_Type, Expr); - return Translate_Implicit_Conv - (Res, Expr_Type, Res_Type, Mode_Value, Expr); end; when Iir_Kind_Length_Array_Attribute => @@ -15844,9 +15860,8 @@ package body Translation is return Chap14.Translate_Succ_Pred_Attribute (Expr); when Iir_Kind_Image_Attribute => - return Translate_Implicit_Conv - (Chap14.Translate_Image_Attribute (Expr), - String_Type_Definition, Res_Type, Mode_Value, Expr); + Res := Chap14.Translate_Image_Attribute (Expr); + when Iir_Kind_Value_Attribute => return Chap14.Translate_Value_Attribute (Expr); @@ -15855,7 +15870,7 @@ package body Translation is when Iir_Kind_Active_Attribute => return Chap14.Translate_Active_Attribute (Expr); when Iir_Kind_Last_Value_Attribute => - return Chap14.Translate_Last_Value_Attribute (Expr); + Res := Chap14.Translate_Last_Value_Attribute (Expr); when Iir_Kind_High_Type_Attribute => return Chap14.Translate_High_Type_Attribute (Get_Type (Expr)); @@ -15874,13 +15889,13 @@ package body Translation is (Get_Prefix (Expr), Ghdl_Signal_Last_Active_Node); when Iir_Kind_Driving_Value_Attribute => - return Chap14.Translate_Driving_Value_Attribute (Expr); + Res := Chap14.Translate_Driving_Value_Attribute (Expr); when Iir_Kind_Driving_Attribute => - return Chap14.Translate_Driving_Attribute (Expr); + Res := Chap14.Translate_Driving_Attribute (Expr); when Iir_Kind_Path_Name_Attribute | Iir_Kind_Instance_Name_Attribute => - return Chap14.Translate_Path_Instance_Name_Attribute (Expr); + Res := Chap14.Translate_Path_Instance_Name_Attribute (Expr); when Iir_Kind_Simple_Name | Iir_Kind_Selected_Name => @@ -15889,6 +15904,14 @@ package body Translation is when others => Error_Kind ("translate_expression", Expr); end case; + + -- Quick test to avoid useless calls. + if Expr_Type /= Res_Type then + Res := Translate_Implicit_Conv + (Res, Expr_Type, Res_Type, Mode_Value, Expr); + end if; + + return Res; end Translate_Expression; -- Check if RNG is of the form: @@ -19411,6 +19434,9 @@ package body Translation is when Type_Mode_E8 => Subprg := Ghdl_Signal_Simple_Assign_E8; Conv := Ghdl_I32_Type; + when Type_Mode_E32 => + Subprg := Ghdl_Signal_Simple_Assign_E32; + Conv := Ghdl_I32_Type; when Type_Mode_I32 | Type_Mode_P32 => Subprg := Ghdl_Signal_Simple_Assign_I32; @@ -19533,6 +19559,9 @@ package body Translation is when Type_Mode_E8 => Subprg := Ghdl_Signal_Start_Assign_E8; Conv := Ghdl_I32_Type; + when Type_Mode_E32 => + Subprg := Ghdl_Signal_Start_Assign_E32; + Conv := Ghdl_I32_Type; when Type_Mode_I32 | Type_Mode_P32 => Subprg := Ghdl_Signal_Start_Assign_I32; @@ -19699,6 +19728,9 @@ package body Translation is when Type_Mode_E8 => Subprg := Ghdl_Signal_Next_Assign_E8; Conv := Ghdl_I32_Type; + when Type_Mode_E32 => + Subprg := Ghdl_Signal_Next_Assign_E32; + Conv := Ghdl_I32_Type; when Type_Mode_I32 | Type_Mode_P32 => Subprg := Ghdl_Signal_Next_Assign_I32; @@ -21014,6 +21046,9 @@ package body Translation is when Type_Mode_E8 => Init_Subprg := Ghdl_Signal_Init_E8; Conv := Ghdl_I32_Type; + when Type_Mode_E32 => + Init_Subprg := Ghdl_Signal_Init_E32; + Conv := Ghdl_I32_Type; when Type_Mode_I32 | Type_Mode_P32 => Init_Subprg := Ghdl_Signal_Init_I32; @@ -22832,6 +22867,8 @@ package body Translation is Subprg := Ghdl_Signal_Driving_Value_B2; when Type_Mode_E8 => Subprg := Ghdl_Signal_Driving_Value_E8; + when Type_Mode_E32 => + Subprg := Ghdl_Signal_Driving_Value_E32; when Type_Mode_I32 | Type_Mode_P32 => Subprg := Ghdl_Signal_Driving_Value_I32; @@ -22888,6 +22925,9 @@ package body Translation is when Type_Mode_E8 => Subprg := Ghdl_Image_E8; Conv := Ghdl_I32_Type; + when Type_Mode_E32 => + Subprg := Ghdl_Image_E32; + Conv := Ghdl_I32_Type; when Type_Mode_I32 => Subprg := Ghdl_Image_I32; Conv := Ghdl_I32_Type; @@ -22942,6 +22982,8 @@ package body Translation is Subprg := Ghdl_Value_B2; when Type_Mode_E8 => Subprg := Ghdl_Value_E8; + when Type_Mode_E32 => + Subprg := Ghdl_Value_E32; when Type_Mode_I32 => Subprg := Ghdl_Value_I32; when Type_Mode_P64 => @@ -26569,6 +26611,12 @@ package body Translation is Create_Image_Value_Subprograms ("e8", Ghdl_I32_Type, True, Ghdl_Image_E8, Ghdl_Value_E8); + -- procedure __ghdl_image_e32 (res : std_string_ptr_node; + -- val : ghdl_i32_type; + -- rti : ghdl_rti_access); + Create_Image_Value_Subprograms + ("e32", Ghdl_I32_Type, True, Ghdl_Image_E32, Ghdl_Value_E32); + -- procedure __ghdl_image_i32 (res : std_string_ptr_node; -- val : ghdl_i32_type); Create_Image_Value_Subprograms @@ -26903,6 +26951,19 @@ package body Translation is Ghdl_Signal_Associate_E8, Ghdl_Signal_Driving_Value_E8); + -- function __ghdl_create_signal_enum8 (init_val : ghdl_i32_type) + -- return __ghdl_signal_ptr; + -- procedure __ghdl_signal_simple_assign_e8 (sign : __ghdl_signal_ptr; + -- val : __ghdl_integer); + Create_Signal_Subprograms ("e32", Ghdl_I32_Type, + Ghdl_Create_Signal_E32, + Ghdl_Signal_Init_E32, + Ghdl_Signal_Simple_Assign_E32, + Ghdl_Signal_Start_Assign_E32, + Ghdl_Signal_Next_Assign_E32, + Ghdl_Signal_Associate_E32, + Ghdl_Signal_Driving_Value_E32); + -- function __ghdl_create_signal_b2 (init_val : ghdl_bool_type) -- return __ghdl_signal_ptr; -- procedure __ghdl_signal_simple_assign_b2 (sign : __ghdl_signal_ptr; @@ -27683,6 +27744,7 @@ package body Translation is begin -- Load the unit in memory to compute the dependence list. Libraries.Load_Design_Unit (Unit, Null_Iir); + Update_Node_Infos; Set_Elab_Flag (Unit, True); Design_Units.Append (Unit); diff --git a/version.ads b/version.ads index 4118496e8..fcd190394 100644 --- a/version.ads +++ b/version.ads @@ -1,4 +1,4 @@ package Version is Ghdl_Version : constant String := - "GHDL 0.22dev (20051220) [Sokcho edition]"; + "GHDL 0.23dev (20060614) [Sokcho edition]"; end Version; |