diff options
| -rw-r--r-- | disp_tree.adb | 10 | ||||
| -rw-r--r-- | iirs.ads | 6 | ||||
| -rw-r--r-- | sem.adb | 8 | ||||
| -rw-r--r-- | translate/ghdldrv/Makefile | 18 | ||||
| -rw-r--r-- | translate/ghdldrv/ghdlrun.adb | 4 | ||||
| -rw-r--r-- | translate/grt/ghdl_main.adb | 3 | ||||
| -rw-r--r-- | translate/grt/grt-images.adb | 14 | ||||
| -rw-r--r-- | translate/grt/grt-images.ads | 8 | ||||
| -rw-r--r-- | translate/grt/grt-types.ads | 5 | ||||
| -rw-r--r-- | translate/trans_decls.ads | 3 | ||||
| -rw-r--r-- | translate/translation.adb | 365 |
11 files changed, 372 insertions, 72 deletions
diff --git a/disp_tree.adb b/disp_tree.adb index db2102a33..1bd6cd118 100644 --- a/disp_tree.adb +++ b/disp_tree.adb @@ -349,14 +349,17 @@ package body Disp_Tree is Disp_Decl_Ident; when Iir_Kind_File_Type_Definition => Put ("file_type_definition"); - Disp_Identifier (Get_Type_Declarator (Tree)); + Disp_Decl_Ident; when Iir_Kind_Subtype_Definition => Put_Line ("subtype_definition"); when Iir_Kind_Physical_Type_Definition => Put ("physical_type_definition"); - Disp_Identifier (Get_Type_Declarator (Tree)); + Disp_Decl_Ident; when Iir_Kind_Physical_Subtype_Definition => Put_Line ("physical_subtype_definition"); + when Iir_Kind_Protected_Type_Declaration => + Put ("protected_type_declaration"); + Disp_Decl_Ident; when Iir_Kind_Scalar_Nature_Definition => Put ("scalar_nature_definition"); @@ -1429,6 +1432,9 @@ package body Disp_Tree is Header ("file type mark:"); Disp_Tree_Flat (Get_File_Type_Mark (Tree), Ntab); when Iir_Kind_Protected_Type_Declaration => + if Flat_Decl then + return; + end if; Header ("staticness: ", False); Disp_Type_Staticness (Tree); Header ("declarator:"); @@ -3751,9 +3751,9 @@ package Iirs is Iir_Predefined_Array_Rol, Iir_Predefined_Array_Ror, - -- Predefined operators for one dimensional array. - -- For bit and boolean type, the operations are the same. For a neutral - -- noun, we use TF (for True/False) instead of Bit, Boolean or Logic. + -- Predefined operators for one dimensional array. + -- For bit and boolean type, the operations are the same. For a neutral + -- noun, we use TF (for True/False) instead of Bit, Boolean or Logic. Iir_Predefined_TF_Array_And, Iir_Predefined_TF_Array_Or, Iir_Predefined_TF_Array_Nand, @@ -1445,11 +1445,12 @@ package body Sem is procedure Set_Subprogram_Overload_Number (Decl : Iir) is + Id : constant Name_Id := Get_Identifier (Decl); Inter : Name_Interpretation_Type; Prev : Iir; Num : Iir_Int32; begin - Inter := Get_Interpretation (Get_Identifier (Decl)); + Inter := Get_Interpretation (Id); while Valid_Interpretation (Inter) and then Is_In_Current_Declarative_Region (Inter) loop @@ -1479,8 +1480,11 @@ package body Sem is -- Implicit declarations aren't taken into account (as they -- are mangled differently). Inter := Get_Next_Interpretation (Inter); + when Iir_Kind_Enumeration_Literal => + -- Enumeration literal are ignored for overload number. + Inter := Get_Next_Interpretation (Inter); when others => - -- Can be an enumeration literal or an error. + -- An error ? Set_Overload_Number (Decl, 0); return; end case; diff --git a/translate/ghdldrv/Makefile b/translate/ghdldrv/Makefile index fc243125e..c4464268d 100644 --- a/translate/ghdldrv/Makefile +++ b/translate/ghdldrv/Makefile @@ -15,7 +15,7 @@ # along with GCC; see the file COPYING. If not, write to the Free # Software Foundation, 59 Temple Place - Suite 330, Boston, MA # 02111-1307, USA. -GNATFLAGS=-gnaty3befhkmr -gnata -gnatwae -aI../.. -aI.. -aI../../psl -aI../grt -aO.. -g -gnatf -gnat05 +GNATFLAGS=-gnaty3befhkmr -gnata -gnatwael -aI../.. -aI.. -aI../../psl -aI../grt -aO.. -g -gnatf -gnat05 GRT_FLAGS=-g LIB_CFLAGS=-g -O2 GNATMAKE=gnatmake @@ -142,18 +142,32 @@ else $(RM) std_standard.s endif +$(LIB08_DIR)/std/std_standard.o: $(GHDL1) +ifeq ($(GHDL),ghdl_llvm) + $(GHDL1) --std=08 -quiet $(LIB_CFLAGS) -c -o $@ --compile-standard +else + $(GHDL1) --std=08 -quiet $(LIB_CFLAGS) -o std_standard.s \ + --compile-standard + $(CC) -c -o $@ std_standard.s + $(RM) std_standard.s +endif + install.v93: std.v93 ieee.v93 synopsys.v93 mentor.v93 install.v87: std.v87 ieee.v87 synopsys.v87 install.v08: std.v08 ieee.v08 install.standard: $(LIB93_DIR)/std/std_standard.o \ - $(LIB87_DIR)/std/std_standard.o + $(LIB87_DIR)/std/std_standard.o \ + $(LIB08_DIR)/std/std_standard.o grt.links: cd ../lib; ln -sf $(GRTSRCDIR)/grt.lst .; ln -sf $(GRTSRCDIR)/libgrt.a .; ln -sf $(GRTSRCDIR)/grt.ver . install.all: install.v87 install.v93 install.standard +install.gcc: + $(MAKE) GHDL=ghdl_gcc install.v08 #install.v87 install.v93 install.v08 + install.mcode: $(MAKE) GHDL=ghdl_mcode install.v87 install.v93 install.v08 diff --git a/translate/ghdldrv/ghdlrun.adb b/translate/ghdldrv/ghdlrun.adb index cc01c83d6..5bcb2b748 100644 --- a/translate/ghdldrv/ghdlrun.adb +++ b/translate/ghdldrv/ghdlrun.adb @@ -553,6 +553,10 @@ package body Ghdlrun is Grt.Images.Ghdl_To_String_F64'Address); Def (Trans_Decls.Ghdl_To_String_F64_Digits, Grt.Images.Ghdl_To_String_F64_Digits'Address); + Def (Trans_Decls.Ghdl_BV_To_Ostring, + Grt.Images.Ghdl_BV_To_Ostring'Address); + Def (Trans_Decls.Ghdl_BV_To_Hstring, + Grt.Images.Ghdl_BV_To_Hstring'Address); -- Find untruncated_text_read, if any. Decl := Find_Untruncated_Text_Read; diff --git a/translate/grt/ghdl_main.adb b/translate/grt/ghdl_main.adb index 256d4299b..ce5b67d7e 100644 --- a/translate/grt/ghdl_main.adb +++ b/translate/grt/ghdl_main.adb @@ -27,8 +27,11 @@ with Grt.Options; use Grt.Options; with Grt.Main; with Grt.Types; use Grt.Types; +-- Some files are only referenced from compiled code. With it here so that +-- they get compiled during build (and elaborated). pragma Warnings (Off); with Grt.Rtis_Binding; +with Grt.Std_Logic_1164; pragma Warnings (On); diff --git a/translate/grt/grt-images.adb b/translate/grt/grt-images.adb index e3d66c186..49bce9d75 100644 --- a/translate/grt/grt-images.adb +++ b/translate/grt/grt-images.adb @@ -165,6 +165,20 @@ package body Grt.Images is Return_String (Res, Str (1 .. P)); end Ghdl_To_String_F64_Digits; + procedure Ghdl_BV_To_Ostring (Res : Std_String_Ptr; + Base : Std_Bit_Vector_Basep; + Len : Ghdl_Index_Type) is + begin + raise Program_Error; + end Ghdl_BV_To_Ostring; + + procedure Ghdl_BV_To_Hstring (Res : Std_String_Ptr; + Base : Std_Bit_Vector_Basep; + Len : Ghdl_Index_Type) is + begin + raise Program_Error; + end Ghdl_BV_To_Hstring; + -- procedure Ghdl_Image_F64 (Res : Std_String_Ptr; Val : Ghdl_F64) -- is -- -- Sign (1) + digit (1) + dot (1) + digits (15) + exp (1) + sign (1) diff --git a/translate/grt/grt-images.ads b/translate/grt/grt-images.ads index cd97fe944..a5d8415a3 100644 --- a/translate/grt/grt-images.ads +++ b/translate/grt/grt-images.ads @@ -46,6 +46,12 @@ package Grt.Images is procedure Ghdl_To_String_F64 (Res : Std_String_Ptr; Val : Ghdl_F64); procedure Ghdl_To_String_F64_Digits (Res : Std_String_Ptr; Val : Ghdl_F64; Nbr_Digits : Ghdl_I32); + procedure Ghdl_BV_To_Ostring (Res : Std_String_Ptr; + Base : Std_Bit_Vector_Basep; + Len : Ghdl_Index_Type); + procedure Ghdl_BV_To_Hstring (Res : Std_String_Ptr; + Base : Std_Bit_Vector_Basep; + Len : Ghdl_Index_Type); private pragma Export (Ada, Ghdl_Image_B1, "__ghdl_image_b1"); pragma Export (C, Ghdl_Image_E8, "__ghdl_image_e8"); @@ -58,4 +64,6 @@ private pragma Export (C, Ghdl_To_String_I32, "__ghdl_to_string_i32"); pragma Export (C, Ghdl_To_String_F64, "__ghdl_to_string_f64"); pragma Export (C, Ghdl_To_String_F64_Digits, "__ghdl_to_string_f64_digits"); + pragma Export (C, Ghdl_BV_To_Ostring, "__ghdl_bv_to_ostring"); + pragma Export (C, Ghdl_BV_To_Hstring, "__ghdl_bv_to_hstring"); end Grt.Images; diff --git a/translate/grt/grt-types.ads b/translate/grt/grt-types.ads index 18ea2b9f3..96bd97b51 100644 --- a/translate/grt/grt-types.ads +++ b/translate/grt/grt-types.ads @@ -86,6 +86,11 @@ package Grt.Types is function To_Std_String_Ptr is new Ada.Unchecked_Conversion (Source => Address, Target => Std_String_Ptr); + type Std_Bit is ('0', '1'); + type Std_Bit_Vector_Uncons is array (Ghdl_Index_Type range <>) of Std_Bit; + subtype Std_Bit_Vector_Base is Std_Bit_Vector_Uncons (Ghdl_Index_Type); + type Std_Bit_Vector_Basep is access all Std_Bit_Vector_Base; + -- An unconstrained array. -- It is in fact a fat pointer to the base and the bounds. type Ghdl_Uc_Array is record diff --git a/translate/trans_decls.ads b/translate/trans_decls.ads index 88e09af11..5ee9989da 100644 --- a/translate/trans_decls.ads +++ b/translate/trans_decls.ads @@ -230,6 +230,9 @@ package Trans_Decls is Ghdl_To_String_I32 : O_Dnode; Ghdl_To_String_F64 : O_Dnode; Ghdl_To_String_F64_Digits : O_Dnode; + Ghdl_BV_To_String : O_Dnode; + Ghdl_BV_To_Ostring : O_Dnode; + Ghdl_BV_To_Hstring : O_Dnode; -- Register a package Ghdl_Rti_Add_Package : O_Dnode; diff --git a/translate/translation.adb b/translate/translation.adb index ecae9d7eb..17d140903 100644 --- a/translate/translation.adb +++ b/translate/translation.adb @@ -2438,7 +2438,7 @@ package body Translation is -- Generate code to increment/decrement a ghdl_index_type variable V. procedure Inc_Var (V : O_Dnode); - --procedure Dec_Var (V : O_Lnode); + procedure Dec_Var (V : O_Dnode); -- Generate code to exit from loop LABEL iff COND is true. procedure Gen_Exit_When (Label : O_Snode; Cond : O_Enode); @@ -3312,17 +3312,17 @@ package body Translation is begin New_Assign_Stmt (New_Obj (V), New_Dyadic_Op (ON_Add_Ov, - New_Value (New_Obj (V)), + New_Obj_Value (V), New_Lit (Ghdl_Index_1))); end Inc_Var; --- procedure Dec_Var (V : O_Lnode) is --- begin --- New_Assign_Stmt --- (V, New_Dyadic_Op (ON_Sub_Ov, --- New_Value (V), --- New_Unsigned_Literal (Ghdl_Index_Type, 1))); --- end Dec_Var; + procedure Dec_Var (V : O_Dnode) is + begin + New_Assign_Stmt (New_Obj (V), + New_Dyadic_Op (ON_Sub_Ov, + New_Obj_Value (V), + New_Lit (Ghdl_Index_1))); + end Dec_Var; procedure Init_Var (V : O_Dnode) is begin @@ -7195,12 +7195,12 @@ package body Translation is ----------------- -- protected -- ----------------- + procedure Translate_Protected_Type (Def : Iir_Protected_Type_Declaration) is - Info : Type_Info_Acc; + Info : constant Type_Info_Acc := Get_Info (Def); + Mark : Id_Mark_Type; begin - Info := Get_Info (Def); - New_Uncomplete_Record_Type (Info.Ortho_Type (Mode_Value)); New_Type_Decl (Create_Identifier, Info.Ortho_Type (Mode_Value)); @@ -7221,14 +7221,17 @@ package body Translation is -- This is just use to set overload number on subprograms, and to -- translate interfaces. + Push_Identifier_Prefix + (Mark, Get_Identifier (Get_Type_Declarator (Def))); Chap4.Translate_Declaration_Chain (Def); + Pop_Identifier_Prefix (Mark); end Translate_Protected_Type; procedure Translate_Protected_Type_Subprograms (Def : Iir_Protected_Type_Declaration) is + Info : constant Type_Info_Acc := Get_Info (Def); El : Iir; - Info : Type_Info_Acc; Inter_List : O_Inter_List; Mark : Id_Mark_Type; Prev_Subprg_Instance : Chap2.Subprg_Instance_Stack; @@ -7236,8 +7239,6 @@ package body Translation is Push_Identifier_Prefix (Mark, Get_Identifier (Get_Type_Declarator (Def))); - Info := Get_Info (Def); - -- Init. Start_Function_Decl (Inter_List, Create_Identifier ("INIT"), Global_Storage, @@ -7282,13 +7283,11 @@ package body Translation is procedure Translate_Protected_Type_Body (Bod : Iir) is - Decl : Iir_Protected_Type_Declaration; + Decl : constant Iir_Protected_Type_Declaration := + Get_Protected_Type_Declaration (Bod); + Info : constant Type_Info_Acc := Get_Info (Decl); Mark : Id_Mark_Type; - Info : Type_Info_Acc; begin - Decl := Get_Protected_Type_Declaration (Bod); - Info := Get_Info (Decl); - Push_Identifier_Prefix (Mark, Get_Identifier (Bod)); -- Create the object type @@ -7328,13 +7327,13 @@ package body Translation is procedure Translate_Protected_Type_Body_Subprograms (Bod : Iir) is - Decl : Iir; - Info : Type_Info_Acc; + Mark : Id_Mark_Type; + Decl : constant Iir := Get_Protected_Type_Declaration (Bod); + Info : constant Type_Info_Acc := Get_Info (Decl); Final : Boolean; Prev_Subprg_Instance : Chap2.Subprg_Instance_Stack; begin - Decl := Get_Protected_Type_Declaration (Bod); - Info := Get_Info (Decl); + Push_Identifier_Prefix (Mark, Get_Identifier (Bod)); -- Subprograms of BOD. Chap2.Push_Subprg_Instance (Info.Ortho_Type (Mode_Value), @@ -7350,6 +7349,8 @@ package body Translation is (Prev_Subprg_Instance, Info.T.Prot_Subprg_Instance_Field); Chap2.Pop_Subprg_Instance (Wki_Obj, Prev_Subprg_Instance); + Pop_Identifier_Prefix (Mark); + if Global_Storage = O_Storage_External then return; end if; @@ -13014,22 +13015,20 @@ package body Translation is function Translate_Indexed_Name_Init (Prefix_Orig : Mnode; Expr : Iir) return Indexed_Name_Data is + Prefix_Type : constant Iir := Get_Type (Get_Prefix (Expr)); + Prefix_Info : constant Type_Info_Acc := Get_Info (Prefix_Type); + Index_List : constant Iir_List := Get_Index_List (Expr); + Type_List : constant Iir_List := Get_Index_Subtype_List (Prefix_Type); + Nbr_Dim : constant Natural := Get_Nbr_Elements (Index_List); Prefix : Mnode; - Prefix_Type : Iir; Index : Iir; - Index_List : Iir_List; - Type_List : Iir_List; Offset : O_Dnode; R : O_Enode; Length : O_Enode; Itype : Iir; Ibasetype : Iir; - Prefix_Info : Type_Info_Acc; - Nbr_Dim : Natural; Range_Ptr : Mnode; begin - Prefix_Type := Get_Type (Get_Prefix (Expr)); - Prefix_Info := Get_Info (Prefix_Type); case Prefix_Info.Type_Mode is when Type_Mode_Fat_Array => Prefix := Stabilize (Prefix_Orig); @@ -13038,9 +13037,6 @@ package body Translation is when others => raise Internal_Error; end case; - Index_List := Get_Index_List (Expr); - Type_List := Get_Index_Subtype_List (Prefix_Type); - Nbr_Dim := Get_Nbr_Elements (Index_List); Offset := Create_Temp (Ghdl_Index_Type); for Dim in 1 .. Nbr_Dim loop Index := Get_Nth_Element (Index_List, Dim - 1); @@ -13137,23 +13133,23 @@ package body Translation is (Prefix : Mnode; Expr : Iir_Slice_Name; Data : out Slice_Name_Data) is -- Type of the prefix. - Prefix_Type : Iir; + Prefix_Type : constant Iir := Get_Type (Get_Prefix (Expr)); -- Type info of the prefix. Prefix_Info : Type_Info_Acc; + -- Type of the first (and only) index of the prefix array type. + Index_Type : constant Iir := Get_Index_Type (Prefix_Type, 0); + -- Type of the slice. - Slice_Type : Iir; + Slice_Type : constant Iir := Get_Type (Expr); Slice_Info : Type_Info_Acc; - -- Type of the first (and only) index of the prefix array type. - Index_Type : Iir; - -- True iff the direction of the slice is known at compile time. Static_Range : Boolean; -- Suffix of the slice (discrete range). - Expr_Range : Iir; + Expr_Range : constant Iir := Get_Suffix (Expr); -- Variable pointing to the prefix. Prefix_Var : Mnode; @@ -13169,15 +13165,10 @@ package body Translation is Unsigned_Diff : O_Dnode; If_Blk1 : O_If_Block; begin - -- Evaluate the prefix. - Slice_Type := Get_Type (Expr); - Expr_Range := Get_Suffix (Expr); - Prefix_Type := Get_Type (Get_Prefix (Expr)); - Index_Type := Get_Index_Type (Prefix_Type, 0); - -- Evaluate slice bounds. Chap3.Create_Array_Subtype (Slice_Type, True); + -- The info may have just been created. Prefix_Info := Get_Info (Prefix_Type); Slice_Info := Get_Info (Slice_Type); @@ -15089,6 +15080,179 @@ package body Translation is return New_Address (New_Obj (Res), Std_String_Ptr_Node); end Translate_To_String; + function Translate_Bv_To_String + (Subprg : O_Dnode; Val : O_Enode; Val_Type : Iir) + return O_Enode + is + Arr : Mnode; + begin + Arr := Stabilize (E2M (Val, Get_Info (Val_Type), Mode_Value)); + return Translate_To_String + (Subprg, + M2E (Chap3.Get_Array_Base (Arr)), + M2E (Chap3.Range_To_Length + (Chap3.Get_Array_Range (Arr, Val_Type, 1)))); + end Translate_Bv_To_String; + + subtype Predefined_Boolean_Logical is Iir_Predefined_Functions range + Iir_Predefined_Boolean_And .. Iir_Predefined_Boolean_Xnor; + + function Translate_Predefined_Logical + (Op : Predefined_Boolean_Logical; Left, Right : O_Enode) + return O_Enode is + begin + case Op is + when Iir_Predefined_Boolean_And => + return New_Dyadic_Op (ON_And, Left, Right); + when Iir_Predefined_Boolean_Or => + return New_Dyadic_Op (ON_Or, Left, Right); + when Iir_Predefined_Boolean_Nand => + return New_Monadic_Op + (ON_Not, New_Dyadic_Op (ON_And, Left, Right)); + when Iir_Predefined_Boolean_Nor => + return New_Monadic_Op + (ON_Not, New_Dyadic_Op (ON_Or, Left, Right)); + when Iir_Predefined_Boolean_Xor => + return New_Dyadic_Op (ON_Xor, Left, Right); + when Iir_Predefined_Boolean_Xnor => + return New_Monadic_Op + (ON_Not, New_Dyadic_Op (ON_Xor, Left, Right)); + end case; + end Translate_Predefined_Logical; + + function Translate_Predefined_TF_Array_Element + (Op : Predefined_Boolean_Logical; + Left, Right : Iir; + Res_Type : Iir) + return O_Enode + is + Arr_Type : constant Iir := Get_Type (Left); + Res_Info : constant Type_Info_Acc := Get_Info (Res_Type); + Base_Ptr_Type : constant O_Tnode := + Res_Info.T.Base_Ptr_Type (Mode_Value); + Arr : Mnode; + El : O_Dnode; + Base : O_Dnode; + Len : O_Dnode; + Label : O_Snode; + Res : Mnode; + begin + -- Translate the array. + Arr := Stabilize (E2M (Translate_Expression (Left), + Get_Info (Arr_Type), Mode_Value)); + + -- Extract its length. + Len := Create_Temp_Init + (Ghdl_Index_Type, + M2E (Chap3.Range_To_Length + (Chap3.Get_Array_Range (Arr, Arr_Type, 1)))); + + -- Allocate the result array. + Base := Create_Temp_Init + (Base_Ptr_Type, + Gen_Alloc (Alloc_Stack, New_Obj_Value (Len), Base_Ptr_Type)); + + Open_Temp; + -- Translate the element. + El := Create_Temp_Init (Get_Ortho_Type (Get_Type (Right), Mode_Value), + Translate_Expression (Right)); + -- Create: + -- loop + -- exit when LEN = 0; + -- LEN := LEN - 1; + -- BASE[LEN] := EL op ARR[LEN]; + -- end loop; + Start_Loop_Stmt (Label); + Gen_Exit_When (Label, New_Compare_Op (ON_Eq, New_Obj_Value (Len), + New_Lit (Ghdl_Index_0), + Ghdl_Bool_Type)); + Dec_Var (Len); + New_Assign_Stmt + (New_Indexed_Acc_Value (New_Obj (Base), + New_Obj_Value (Len)), + Translate_Predefined_Logical + (Op, + New_Obj_Value (El), + M2E (Chap3.Index_Base (Chap3.Get_Array_Base (Arr), + Arr_Type, New_Obj_Value (Len))))); + Finish_Loop_Stmt (Label); + Close_Temp; + + Res := Create_Temp (Res_Info, Mode_Value); + New_Assign_Stmt (M2Lp (Chap3.Get_Array_Base (Res)), + New_Obj_Value (Base)); + New_Assign_Stmt (M2Lp (Chap3.Get_Array_Bounds (Res)), + M2Addr (Chap3.Get_Array_Bounds (Arr))); + + return M2E (Res); + end Translate_Predefined_TF_Array_Element; + + function Translate_Predefined_TF_Reduction + (Op : Predefined_Boolean_Logical; Operand : Iir; Res_Type : Iir) + return O_Enode + is + Arr_Type : constant Iir := Get_Type (Operand); + Enums : constant Iir_List := + Get_Enumeration_Literal_List (Get_Base_Type (Res_Type)); + Init_Enum : Iir; + + Res : O_Dnode; + Arr_Expr : O_Enode; + Arr : Mnode; + Len : O_Dnode; + Label : O_Snode; + begin + case Op is + when Iir_Predefined_Boolean_And + | Iir_Predefined_Boolean_Nand => + Init_Enum := Get_Nth_Element (Enums, 1); + when Iir_Predefined_Boolean_Or + | Iir_Predefined_Boolean_Nor + | Iir_Predefined_Boolean_Xor + | Iir_Predefined_Boolean_Xnor => + Init_Enum := Get_Nth_Element (Enums, 0); + end case; + + Res := Create_Temp_Init (Get_Ortho_Type (Res_Type, Mode_Value), + New_Lit (Get_Ortho_Expr (Init_Enum))); + + Open_Temp; + -- Translate the array. Note that Translate_Expression may create + -- the info for the array type, so be sure to call it before calling + -- Get_Info. + Arr_Expr := Translate_Expression (Operand); + Arr := Stabilize (E2M (Arr_Expr, Get_Info (Arr_Type), Mode_Value)); + + -- Extract its length. + Len := Create_Temp_Init + (Ghdl_Index_Type, + M2E (Chap3.Range_To_Length + (Chap3.Get_Array_Range (Arr, Arr_Type, 1)))); + + -- Create: + -- loop + -- exit when LEN = 0; + -- LEN := LEN - 1; + -- RES := RES op ARR[LEN]; + -- end loop; + Start_Loop_Stmt (Label); + Gen_Exit_When (Label, New_Compare_Op (ON_Eq, New_Obj_Value (Len), + New_Lit (Ghdl_Index_0), + Ghdl_Bool_Type)); + Dec_Var (Len); + New_Assign_Stmt + (New_Obj (Res), + Translate_Predefined_Logical + (Op, + New_Obj_Value (Res), + M2E (Chap3.Index_Base (Chap3.Get_Array_Base (Arr), + Arr_Type, New_Obj_Value (Len))))); + Finish_Loop_Stmt (Label); + Close_Temp; + + return New_Obj_Value (Res); + end Translate_Predefined_TF_Reduction; + function Translate_Predefined_Operator (Imp : Iir_Implicit_Function_Declaration; Left, Right : Iir; @@ -15119,18 +15283,79 @@ package body Translation is -- Right operand of shortcur operators may not be evaluated. return Translate_Shortcut_Operator (Imp, Left, Right); + -- Operands of min/max are evaluated in a declare block. when Iir_Predefined_Enum_Minimum | Iir_Predefined_Integer_Minimum | Iir_Predefined_Floating_Minimum | Iir_Predefined_Physical_Minimum => - -- Operands of min/max are evaluated in a declare block. return Translate_Scalar_Min_Max (ON_Le, Left, Right, Res_Type); when Iir_Predefined_Enum_Maximum | Iir_Predefined_Integer_Maximum | Iir_Predefined_Floating_Maximum | Iir_Predefined_Physical_Maximum => - -- Operands of min/max are evaluated in a declare block. return Translate_Scalar_Min_Max (ON_Ge, Left, Right, Res_Type); + + -- Avoid implicit conversion of the array parameters to the + -- unbounded type for optimizing purpose. FIXME: should do the + -- same for the result. + when Iir_Predefined_TF_Array_Element_And => + return Translate_Predefined_TF_Array_Element + (Iir_Predefined_Boolean_And, Left, Right, Res_Type); + when Iir_Predefined_TF_Element_Array_And => + return Translate_Predefined_TF_Array_Element + (Iir_Predefined_Boolean_And, Right, Left, Res_Type); + when Iir_Predefined_TF_Array_Element_Or => + return Translate_Predefined_TF_Array_Element + (Iir_Predefined_Boolean_Or, Left, Right, Res_Type); + when Iir_Predefined_TF_Element_Array_Or => + return Translate_Predefined_TF_Array_Element + (Iir_Predefined_Boolean_Or, Right, Left, Res_Type); + when Iir_Predefined_TF_Array_Element_Nand => + return Translate_Predefined_TF_Array_Element + (Iir_Predefined_Boolean_Nand, Left, Right, Res_Type); + when Iir_Predefined_TF_Element_Array_Nand => + return Translate_Predefined_TF_Array_Element + (Iir_Predefined_Boolean_Nand, Right, Left, Res_Type); + when Iir_Predefined_TF_Array_Element_Nor => + return Translate_Predefined_TF_Array_Element + (Iir_Predefined_Boolean_Nor, Left, Right, Res_Type); + when Iir_Predefined_TF_Element_Array_Nor => + return Translate_Predefined_TF_Array_Element + (Iir_Predefined_Boolean_Nor, Right, Left, Res_Type); + when Iir_Predefined_TF_Array_Element_Xor => + return Translate_Predefined_TF_Array_Element + (Iir_Predefined_Boolean_Xor, Left, Right, Res_Type); + when Iir_Predefined_TF_Element_Array_Xor => + return Translate_Predefined_TF_Array_Element + (Iir_Predefined_Boolean_Xor, Right, Left, Res_Type); + when Iir_Predefined_TF_Array_Element_Xnor => + return Translate_Predefined_TF_Array_Element + (Iir_Predefined_Boolean_Xnor, Left, Right, Res_Type); + when Iir_Predefined_TF_Element_Array_Xnor => + return Translate_Predefined_TF_Array_Element + (Iir_Predefined_Boolean_Xnor, Right, Left, Res_Type); + + -- Avoid implicit conversion of the array parameters to the + -- unbounded type for optimizing purpose. + when Iir_Predefined_TF_Reduction_And => + return Translate_Predefined_TF_Reduction + (Iir_Predefined_Boolean_And, Left, Res_Type); + when Iir_Predefined_TF_Reduction_Or => + return Translate_Predefined_TF_Reduction + (Iir_Predefined_Boolean_Or, Left, Res_Type); + when Iir_Predefined_TF_Reduction_Nand => + return Translate_Predefined_TF_Reduction + (Iir_Predefined_Boolean_Nand, Left, Res_Type); + when Iir_Predefined_TF_Reduction_Nor => + return Translate_Predefined_TF_Reduction + (Iir_Predefined_Boolean_Nor, Left, Res_Type); + when Iir_Predefined_TF_Reduction_Xor => + return Translate_Predefined_TF_Reduction + (Iir_Predefined_Boolean_Xor, Left, Res_Type); + when Iir_Predefined_TF_Reduction_Xnor => + return Translate_Predefined_TF_Reduction + (Iir_Predefined_Boolean_Xnor, Left, Res_Type); + when others => null; end case; @@ -15189,8 +15414,8 @@ package body Translation is case Kind is when Iir_Predefined_Bit_Xnor | Iir_Predefined_Boolean_Xnor => - return New_Monadic_Op - (ON_Not, New_Dyadic_Op (ON_Xor, Left_Tree, Right_Tree)); + return Translate_Predefined_Logical + (Iir_Predefined_Boolean_Xnor, Left_Tree, Right_Tree); when Iir_Predefined_Bit_Condition => return New_Compare_Op (ON_Eq, Left_Tree, New_Lit (Get_Ortho_Expr (Bit_1)), @@ -15442,6 +15667,12 @@ package body Translation is (Ghdl_To_String_F64_Digits, New_Convert_Ov (Left_Tree, Ghdl_Real_Type), New_Convert_Ov (Right_Tree, Ghdl_I32_Type)); + when Iir_Predefined_Bit_Vector_To_Ostring => + return Translate_Bv_To_String + (Ghdl_BV_To_Ostring, Left_Tree, Left_Type); + when Iir_Predefined_Bit_Vector_To_Hstring => + return Translate_Bv_To_String + (Ghdl_BV_To_Hstring, Left_Tree, Left_Type); when others => Ada.Text_IO.Put_Line @@ -28882,21 +29113,20 @@ package body Translation is Finish_Subprogram_Decl (Interfaces, Subprg); end Create_Std_Ulogic_Match_Subprogram; - -- procedure __ghdl_to_string_NAME (res : std_string_ptr_node; - -- val : VAL_TYPE; - -- ARG2_NAME : ARG2_TYPE); + -- procedure NAME (res : std_string_ptr_node; + -- val : VAL_TYPE; + -- ARG2_NAME : ARG2_TYPE); procedure Create_To_String_Subprogram (Name : String; Subprg : out O_Dnode; Val_Type : O_Tnode; - Arg2_Type : O_Tnode; - Arg2_Name : String) + Arg2_Type : O_Tnode := O_Tnode_Null; + Arg2_Name : String := "") is Interfaces : O_Inter_List; Param : O_Dnode; begin Start_Procedure_Decl - (Interfaces, Get_Identifier ("__ghdl_to_string_" & Name), - O_Storage_External); + (Interfaces, Get_Identifier (Name), O_Storage_External); New_Interface_Decl (Interfaces, Param, Get_Identifier ("res"), Std_String_Ptr_Node); New_Interface_Decl @@ -29704,14 +29934,23 @@ package body Translation is -- Create To_String subprograms. Create_To_String_Subprogram - ("i32", Ghdl_To_String_I32, Ghdl_I32_Type, - O_Tnode_Null, ""); + ("__ghdl_to_string_i32", Ghdl_To_String_I32, Ghdl_I32_Type); Create_To_String_Subprogram - ("f64", Ghdl_To_String_F64, Ghdl_Real_Type, - O_Tnode_Null, ""); + ("__ghdl_to_string_f64", Ghdl_To_String_F64, Ghdl_Real_Type); Create_To_String_Subprogram - ("f64_digits", Ghdl_To_String_F64_Digits, Ghdl_Real_Type, - Ghdl_I32_Type, "nbr_digits"); + ("__ghdl_to_string_f64_digits", Ghdl_To_String_F64_Digits, + Ghdl_Real_Type, Ghdl_I32_Type, "nbr_digits"); + declare + Bv_Base_Ptr : constant O_Tnode := + Get_Info (Bit_Vector_Type_Definition).T.Base_Ptr_Type (Mode_Value); + begin + Create_To_String_Subprogram + ("__ghdl_bv_to_ostring", Ghdl_BV_To_Ostring, + Bv_Base_Ptr, Ghdl_Index_Type, "len"); + Create_To_String_Subprogram + ("__ghdl_bv_to_hstring", Ghdl_BV_To_Hstring, + Bv_Base_Ptr, Ghdl_Index_Type, "len"); + end; end Post_Initialize; procedure Translate_Type_Implicit_Subprograms (Decl : in out Iir) |